home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / grids.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  135.0 KB  |  4,679 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Grids;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Messages, Windows, Classes, Graphics, Menus, Controls, Forms,
  17.   StdCtrls, Mask;
  18.  
  19. const
  20.   MaxCustomExtents = MaxListSize;
  21.   MaxShortInt = High(ShortInt);
  22.  
  23. type
  24.   EInvalidGridOperation = class(Exception);
  25.  
  26.   { Internal grid types }
  27.   TGetExtentsFunc = function(Index: Longint): Integer of object;
  28.  
  29.   TGridAxisDrawInfo = record
  30.     EffectiveLineWidth: Integer;
  31.     FixedBoundary: Integer;
  32.     GridBoundary: Integer;
  33.     GridExtent: Integer;
  34.     LastFullVisibleCell: Longint;
  35.     FullVisBoundary: Integer;
  36.     FixedCellCount: Integer;
  37.     FirstGridCell: Integer;
  38.     GridCellCount: Integer;
  39.     GetExtent: TGetExtentsFunc;
  40.   end;
  41.  
  42.   TGridDrawInfo = record
  43.     Horz, Vert: TGridAxisDrawInfo;
  44.   end;
  45.  
  46.   TGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing,
  47.     gsRowMoving, gsColMoving);
  48.  
  49.   { TInplaceEdit }
  50.   { The inplace editor is not intended to be used outside the grid }
  51.  
  52.   TCustomGrid = class;
  53.  
  54.   TInplaceEdit = class(TCustomMaskEdit)
  55.   private
  56.     FGrid: TCustomGrid;
  57.     FClickTime: Longint;
  58.     procedure InternalMove(const Loc: TRect; Redraw: Boolean);
  59.     procedure SetGrid(Value: TCustomGrid);
  60.     procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  61.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  62.     procedure WMPaste(var Message); message WM_PASTE;
  63.     procedure WMCut(var Message); message WM_CUT;
  64.     procedure WMClear(var Message); message WM_CLEAR;
  65.   protected
  66.     procedure CreateParams(var Params: TCreateParams); override;
  67.     procedure DblClick; override;
  68.     function EditCanModify: Boolean; override;
  69.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  70.     procedure KeyPress(var Key: Char); override;
  71.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  72.     procedure BoundsChanged; virtual;
  73.     procedure UpdateContents; virtual;
  74.     procedure WndProc(var Message: TMessage); override;
  75.     property  Grid: TCustomGrid read FGrid;
  76.   public
  77.     constructor Create(AOwner: TComponent); override;
  78.     procedure Deselect;
  79.     procedure Hide;
  80.     procedure Invalidate;
  81.     procedure Move(const Loc: TRect);
  82.     function PosEqual(const Rect: TRect): Boolean;
  83.     procedure SetFocus;
  84.     procedure UpdateLoc(const Loc: TRect);
  85.     function Visible: Boolean;
  86.   end;
  87.  
  88.   { TCustomGrid }
  89.  
  90.   { TCustomGrid is an abstract base class that can be used to implement
  91.     general purpose grid style controls.  The control will call DrawCell for
  92.     each of the cells allowing the derived class to fill in the contents of
  93.     the cell.  The base class handles scrolling, selection, cursor keys, and
  94.     scrollbars.
  95.       DrawCell
  96.         Called by Paint. If DefaultDrawing is true the font and brush are
  97.         intialized to the control font and cell color.  The cell is prepainted
  98.         in the cell color and a focus rect is drawn in the focused cell after
  99.         DrawCell returns.  The state passed will reflect whether the cell is
  100.         a fixed cell, the focused cell or in the selection.
  101.       SizeChanged
  102.         Called when the size of the grid has changed.
  103.       BorderStyle
  104.         Allows a single line border to be drawn around the control.
  105.       Col
  106.         The current column of the focused cell (runtime only).
  107.       ColCount
  108.         The number of columns in the grid.
  109.       ColWidths
  110.         The width of each column (up to a maximum MaxCustomExtents, runtime
  111.         only).
  112.       DefaultColWidth
  113.         The default column width.  Changing this value will throw away any
  114.         customization done either visually or through ColWidths.
  115.       DefaultDrawing
  116.         Indicates whether the Paint should do the drawing talked about above in
  117.         DrawCell.
  118.       DefaultRowHeight
  119.         The default row height.  Changing this value will throw away any
  120.         customization done either visually or through RowHeights.
  121.       FixedCols
  122.         The number of non-scrolling columns.  This value must be at least one
  123.         below ColCount.
  124.       FixedRows
  125.         The number of non-scrolling rows.  This value must be at least one
  126.         below RowCount.
  127.       GridLineWidth
  128.         The width of the lines drawn between the cells.
  129.       LeftCol
  130.         The index of the left most displayed column (runtime only).
  131.       Options
  132.         The following options are available:
  133.           goFixedHorzLine:     Draw horizontal grid lines in the fixed cell area.
  134.           goFixedVertLine:     Draw veritical grid lines in the fixed cell area.
  135.           goHorzLine:          Draw horizontal lines between cells.
  136.           goVertLine:          Draw vertical lines between cells.
  137.           goRangeSelect:       Allow a range of cells to be selected.
  138.           goDrawFocusSelected: Draw the focused cell in the selected color.
  139.           goRowSizing:         Allows rows to be individually resized.
  140.           goColSizing:         Allows columns to be individually resized.
  141.           goRowMoving:         Allows rows to be moved with the mouse
  142.           goColMoving:         Allows columns to be moved with the mouse.
  143.           goEditing:           Places an edit control over the focused cell.
  144.           goAlwaysShowEditor:  Always shows the editor in place instead of
  145.                                waiting for a keypress or F2 to display it.
  146.           goTabs:              Enables the tabbing between columns.
  147.           goRowSelect:         Selection and movement is done a row at a time.
  148.       Row
  149.         The row of the focused cell (runtime only).
  150.       RowCount
  151.         The number of rows in the grid.
  152.       RowHeights
  153.         The hieght of each row (up to a maximum MaxCustomExtents, runtime
  154.         only).
  155.       ScrollBars
  156.         Determines whether the control has scrollbars.
  157.       Selection
  158.         A TGridRect of the current selection.
  159.       TopLeftChanged
  160.         Called when the TopRow or LeftCol change.
  161.       TopRow
  162.         The index of the top most row displayed (runtime only)
  163.       VisibleColCount
  164.         The number of columns fully displayed.  There could be one more column
  165.         partially displayed.
  166.       VisibleRowCount
  167.         The number of rows fully displayed.  There could be one more row
  168.         partially displayed.
  169.  
  170.     Protected members, for implementors of TCustomGrid descendents
  171.       DesignOptionBoost
  172.         Options mixed in only at design time to aid design-time editing.
  173.         Default = [goColSizing, goRowSizing], which makes grid cols and rows
  174.         resizeable at design time, regardless of the Options settings.
  175.      }
  176.  
  177.   TGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  178.     goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
  179.     goColMoving, goEditing, goTabs, goRowSelect,
  180.     goAlwaysShowEditor, goThumbTracking);
  181.   TGridOptions = set of TGridOption;
  182.   TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
  183.   TGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);
  184.  
  185.   TGridCoord = record
  186.     X: Longint;
  187.     Y: Longint;
  188.   end;
  189.  
  190.   TGridRect = record
  191.     case Integer of
  192.       0: (Left, Top, Right, Bottom: Longint);
  193.       1: (TopLeft, BottomRight: TGridCoord);
  194.   end;
  195.  
  196.   TSelectCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  197.     var CanSelect: Boolean) of object;
  198.   TDrawCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  199.     Rect: TRect; State: TGridDrawState) of object;
  200.  
  201.   TCustomGrid = class(TCustomControl)
  202.   private
  203.     FAnchor: TGridCoord;
  204.     FBorderStyle: TBorderStyle;
  205.     FCanEditModify: Boolean;
  206.     FColCount: Longint;
  207.     FColWidths: Pointer;
  208.     FTabStops: Pointer;
  209.     FCurrent: TGridCoord;
  210.     FDefaultColWidth: Integer;
  211.     FDefaultRowHeight: Integer;
  212.     FFixedCols: Integer;
  213.     FFixedRows: Integer;
  214.     FFixedColor: TColor;
  215.     FGridLineWidth: Integer;
  216.     FOptions: TGridOptions;
  217.     FRowCount: Longint;
  218.     FRowHeights: Pointer;
  219.     FScrollBars: TScrollStyle;
  220.     FTopLeft: TGridCoord;
  221.     FSizingIndex: Longint;
  222.     FSizingPos, FSizingOfs: Integer;
  223.     FMoveIndex, FMovePos: Longint;
  224.     FHitTest: TPoint;
  225.     FInplaceEdit: TInplaceEdit;
  226.     FInplaceCol, FInplaceRow: Longint;
  227.     FColOffset: Integer;
  228.     FDefaultDrawing: Boolean;
  229.     FEditorMode: Boolean;
  230.     function CalcCoordFromPoint(X, Y: Integer;
  231.       const DrawInfo: TGridDrawInfo): TGridCoord;
  232.     procedure CalcDrawInfo(var DrawInfo: TGridDrawInfo);
  233.     procedure CalcDrawInfoXY(var DrawInfo: TGridDrawInfo;
  234.       UseWidth, UseHeight: Integer);
  235.     procedure CalcFixedInfo(var DrawInfo: TGridDrawInfo);
  236.     function CalcMaxTopLeft(const Coord: TGridCoord;
  237.       const DrawInfo: TGridDrawInfo): TGridCoord;
  238.     procedure CalcSizingState(X, Y: Integer; var State: TGridState;
  239.       var Index: Longint; var SizingPos, SizingOfs: Integer;
  240.       var FixedInfo: TGridDrawInfo);
  241.     procedure ChangeSize(NewColCount, NewRowCount: Longint);
  242.     procedure ClampInView(const Coord: TGridCoord);
  243.     procedure DrawSizingLine(const DrawInfo: TGridDrawInfo);
  244.     procedure DrawMove;
  245.     procedure FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  246.     procedure GridRectToScreenRect(GridRect: TGridRect;
  247.       var ScreenRect: TRect; IncludeLine: Boolean);
  248.     procedure HideEdit;
  249.     procedure Initialize;
  250.     procedure InvalidateGrid;
  251.     procedure InvalidateRect(ARect: TGridRect);
  252.     procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  253.     procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  254.     procedure MoveAnchor(const NewAnchor: TGridCoord);
  255.     procedure MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TGridDrawInfo;
  256.       var Axis: TGridAxisDrawInfo; Scrollbar: Integer);
  257.     procedure MoveCurrent(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  258.     procedure MoveTopLeft(ALeft, ATop: Longint);
  259.     procedure ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  260.     procedure ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  261.     procedure SelectionMoved(const OldSel: TGridRect);
  262.     procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TGridDrawInfo);
  263.     procedure TopLeftMoved(const OldTopLeft: TGridCoord);
  264.     procedure UpdateScrollPos;
  265.     procedure UpdateScrollRange;
  266.     function GetColWidths(Index: Longint): Integer;
  267.     function GetRowHeights(Index: Longint): Integer;
  268.     function GetSelection: TGridRect;
  269.     function GetTabStops(Index: Longint): Boolean;
  270.     function GetVisibleColCount: Integer;
  271.     function GetVisibleRowCount: Integer;
  272.     procedure ReadColWidths(Reader: TReader);
  273.     procedure ReadRowHeights(Reader: TReader);
  274.     procedure SetBorderStyle(Value: TBorderStyle);
  275.     procedure SetCol(Value: Longint);
  276.     procedure SetColCount(Value: Longint);
  277.     procedure SetColWidths(Index: Longint; Value: Integer);
  278.     procedure SetDefaultColWidth(Value: Integer);
  279.     procedure SetDefaultRowHeight(Value: Integer);
  280.     procedure SetEditorMode(Value: Boolean);
  281.     procedure SetFixedColor(Value: TColor);
  282.     procedure SetFixedCols(Value: Integer);
  283.     procedure SetFixedRows(Value: Integer);
  284.     procedure SetGridLineWidth(Value: Integer);
  285.     procedure SetLeftCol(Value: Longint);
  286.     procedure SetOptions(Value: TGridOptions);
  287.     procedure SetRow(Value: Longint);
  288.     procedure SetRowCount(Value: Longint);
  289.     procedure SetRowHeights(Index: Longint; Value: Integer);
  290.     procedure SetScrollBars(Value: TScrollStyle);
  291.     procedure SetSelection(Value: TGridRect);
  292.     procedure SetTabStops(Index: Longint; Value: Boolean);
  293.     procedure SetTopRow(Value: Longint);
  294.     procedure UpdateEdit;
  295.     procedure UpdateText;
  296.     procedure WriteColWidths(Writer: TWriter);
  297.     procedure WriteRowHeights(Writer: TWriter);
  298.     procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
  299.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  300.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  301.     procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  302.     procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  303.     procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  304.     procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  305.     procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
  306.     procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  307.     procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  308.     procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
  309.     procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  310.     procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  311.     procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
  312.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  313.     procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
  314.     procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  315.   protected
  316.     FGridState: TGridState;
  317.     FSaveCellExtents: Boolean;
  318.     DesignOptionsBoost: TGridOptions;
  319.     function CreateEditor: TInplaceEdit; virtual;
  320.     procedure CreateParams(var Params: TCreateParams); override;
  321.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  322.     procedure KeyPress(var Key: Char); override;
  323.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  324.       X, Y: Integer); override;
  325.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  326.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  327.       X, Y: Integer); override;
  328.     procedure AdjustSize(Index, Amount: Longint; Rows: Boolean); dynamic;
  329.     function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  330.     procedure DoExit; override;
  331.     function CellRect(ACol, ARow: Longint): TRect;
  332.     function CanEditAcceptKey(Key: Char): Boolean; dynamic;
  333.     function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
  334.     function CanEditModify: Boolean; dynamic;
  335.     function CanEditShow: Boolean; virtual;
  336.     function GetEditText(ACol, ARow: Longint): string; dynamic;
  337.     procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic;
  338.     function GetEditMask(ACol, ARow: Longint): string; dynamic;
  339.     function GetEditLimit: Integer; dynamic;
  340.     function GetGridWidth: Integer;
  341.     function GetGridHeight: Integer;
  342.     procedure HideEditor;
  343.     procedure ShowEditor;
  344.     procedure ShowEditorChar(Ch: Char);
  345.     procedure InvalidateEditor;
  346.     procedure MoveColumn(FromIndex, ToIndex: Longint);
  347.     procedure ColumnMoved(FromIndex, ToIndex: Longint); dynamic;
  348.     procedure MoveRow(FromIndex, ToIndex: Longint);
  349.     procedure RowMoved(FromIndex, ToIndex: Longint); dynamic;
  350.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  351.       AState: TGridDrawState); virtual; abstract;
  352.     procedure DefineProperties(Filer: TFiler); override;
  353.     procedure MoveColRow(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  354.     function SelectCell(ACol, ARow: Longint): Boolean; virtual;
  355.     procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
  356.     function Sizing(X, Y: Integer): Boolean;
  357.     procedure ScrollData(DX, DY: Integer);
  358.     procedure InvalidateCell(ACol, ARow: Longint);
  359.     procedure InvalidateCol(ACol: Longint);
  360.     procedure InvalidateRow(ARow: Longint);
  361.     procedure TopLeftChanged; dynamic;
  362.     procedure TimedScroll(Direction: TGridScrollDirection); dynamic;
  363.     procedure Paint; override;
  364.     procedure ColWidthsChanged; dynamic;
  365.     procedure RowHeightsChanged; dynamic;
  366.     procedure DeleteColumn(ACol: Longint);
  367.     procedure DeleteRow(ARow: Longint);
  368.     procedure UpdateDesigner;
  369.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  370.     property Col: Longint read FCurrent.X write SetCol;
  371.     property Color default clWindow;
  372.     property ColCount: Longint read FColCount write SetColCount default 5;
  373.     property ColWidths[Index: Longint]: Integer read GetColWidths write SetColWidths;
  374.     property DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default 64;
  375.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
  376.     property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 24;
  377.     property EditorMode: Boolean read FEditorMode write SetEditorMode;
  378.     property FixedColor: TColor read FFixedColor write SetFixedColor default clBtnFace;
  379.     property FixedCols: Integer read FFixedCols write SetFixedCols default 1;
  380.     property FixedRows: Integer read FFixedRows write SetFixedRows default 1;
  381.     property GridHeight: Integer read GetGridHeight;
  382.     property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default 1;
  383.     property GridWidth: Integer read GetGridWidth;
  384.     property HitTest: TPoint read FHitTest;
  385.     property InplaceEditor: TInplaceEdit read FInplaceEdit;
  386.     property LeftCol: Longint read FTopLeft.X write SetLeftCol;
  387.     property Options: TGridOptions read FOptions write SetOptions
  388.       default [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  389.       goRangeSelect];
  390.     property ParentColor default False;
  391.     property Row: Longint read FCurrent.Y write SetRow;
  392.     property RowCount: Longint read FRowCount write SetRowCount default 5;
  393.     property RowHeights[Index: Longint]: Integer read GetRowHeights write SetRowHeights;
  394.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
  395.     property Selection: TGridRect read GetSelection write SetSelection;
  396.     property TabStops[Index: Longint]: Boolean read GetTabStops write SetTabStops;
  397.     property TopRow: Longint read FTopLeft.Y write SetTopRow;
  398.     property VisibleColCount: Integer read GetVisibleColCount;
  399.     property VisibleRowCount: Integer read GetVisibleRowCount;
  400.   public
  401.     constructor Create(AOwner: TComponent); override;
  402.     destructor Destroy; override;
  403.     function MouseCoord(X, Y: Integer): TGridCoord;
  404.   published
  405.     property TabStop default True;
  406.   end;
  407.  
  408.   { TDrawGrid }
  409.  
  410.   { A grid relies on the OnDrawCell event to display the cells.
  411.      CellRect
  412.        This method returns control relative screen coordinates of the cell or
  413.        an empty rectangle if the cell is not visible.
  414.      EditorMode
  415.        Setting to true shows the editor, as if the F2 key was pressed, when
  416.        goEditing is turned on and goAlwaysShowEditor is turned off.
  417.      MouseToCell
  418.        Takes control relative screen X, Y location and fills in the column and
  419.        row that contain that point.
  420.      OnColumnMoved
  421.        Called when the user request to move a column with the mouse when
  422.        the goColMoving option is on.
  423.      OnDrawCell
  424.        This event is passed the same information as the DrawCell method
  425.        discussed above.
  426.      OnGetEditMask
  427.        Called to retrieve edit mask in the inplace editor when goEditing is
  428.        turned on.
  429.      OnGetEditText
  430.        Called to retrieve text to edit when goEditing is turned on.
  431.      OnRowMoved
  432.        Called when the user request to move a row with the mouse when
  433.        the goRowMoving option is on.
  434.      OnSetEditText
  435.        Called when goEditing is turned on to reflect changes to the text
  436.        made by the editor.
  437.      OnTopLeftChanged
  438.        Invoked when TopRow or LeftCol change. }
  439.  
  440.   TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: string) of object;
  441.   TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: string) of object;
  442.   TMovedEvent = procedure (Sender: TObject; FromIndex, ToIndex: Longint) of object;
  443.  
  444.   TDrawGrid = class(TCustomGrid)
  445.   private
  446.     FOnColumnMoved: TMovedEvent;
  447.     FOnDrawCell: TDrawCellEvent;
  448.     FOnGetEditMask: TGetEditEvent;
  449.     FOnGetEditText: TGetEditEvent;
  450.     FOnRowMoved: TMovedEvent;
  451.     FOnSelectCell: TSelectCellEvent;
  452.     FOnSetEditText: TSetEditEvent;
  453.     FOnTopLeftChanged: TNotifyEvent;
  454.   protected
  455.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  456.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  457.       AState: TGridDrawState); override;
  458.     function GetEditMask(ACol, ARow: Longint): string; override;
  459.     function GetEditText(ACol, ARow: Longint): string; override;
  460.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  461.     function SelectCell(ACol, ARow: Longint): Boolean; override;
  462.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  463.     procedure TopLeftChanged; override;
  464.   public
  465.     function CellRect(ACol, ARow: Longint): TRect;
  466.     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  467.     property Canvas;
  468.     property Col;
  469.     property ColWidths;
  470.     property EditorMode;
  471.     property GridHeight;
  472.     property GridWidth;
  473.     property LeftCol;
  474.     property Selection;
  475.     property Row;
  476.     property RowHeights;
  477.     property TabStops;
  478.     property TopRow;
  479.   published
  480.     property Align;
  481.     property BorderStyle;
  482.     property Color;
  483.     property ColCount;
  484.     property Ctl3D;
  485.     property DefaultColWidth;
  486.     property DefaultRowHeight;
  487.     property DefaultDrawing;
  488.     property DragCursor;
  489.     property DragMode;
  490.     property Enabled;
  491.     property FixedColor;
  492.     property FixedCols;
  493.     property RowCount;
  494.     property FixedRows;
  495.     property Font;
  496.     property GridLineWidth;
  497.     property Options;
  498.     property ParentColor;
  499.     property ParentCtl3D;
  500.     property ParentFont;
  501.     property ParentShowHint;
  502.     property PopupMenu;
  503.     property ScrollBars;
  504.     property ShowHint;
  505.     property TabOrder;
  506.     property TabStop;
  507.     property Visible;
  508.     property VisibleColCount;
  509.     property VisibleRowCount;
  510.     property OnClick;
  511.     property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
  512.     property OnDblClick;
  513.     property OnDragDrop;
  514.     property OnDragOver;
  515.     property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
  516.     property OnEndDrag;
  517.     property OnEnter;
  518.     property OnExit;
  519.     property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
  520.     property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
  521.     property OnKeyDown;
  522.     property OnKeyPress;
  523.     property OnKeyUp;
  524.     property OnMouseDown;
  525.     property OnMouseMove;
  526.     property OnMouseUp;
  527.     property OnRowMoved: TMovedEvent read FOnRowMoved write FOnRowMoved;
  528.     property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
  529.     property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText;
  530.     property OnStartDrag;
  531.     property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
  532.   end;
  533.  
  534.   { TStringGrid }
  535.  
  536.   { TStringGrid adds to TDrawGrid the ability to save a string and associated
  537.     object (much like TListBox).  It also adds to the DefaultDrawing the drawing
  538.     of the string associated with the current cell.
  539.       Cells
  540.         A ColCount by RowCount array of strings which are associated with each
  541.         cell.  By default, the string is drawn into the cell before OnDrawCell
  542.         is called.  This can be turned off (along with all the other default
  543.         drawing) by setting DefaultDrawing to false.
  544.       Cols
  545.         A TStrings object that contains the strings and objects in the column
  546.         indicated by Index.  The TStrings will always have a count of RowCount.
  547.         If a another TStrings is assigned to it, the strings and objects beyond
  548.         RowCount are ignored.
  549.       Objects
  550.         A ColCount by Rowcount array of TObject's associated with each cell.
  551.         Object put into this array will *not* be destroyed automatically when
  552.         the grid is destroyed.
  553.       Rows
  554.         A TStrings object that contains the strings and objects in the row
  555.         indicated by Index.  The TStrings will always have a count of ColCount.
  556.         If a another TStrings is assigned to it, the strings and objects beyond
  557.         ColCount are ignored. }
  558.  
  559.   TStringGrid = class;
  560.  
  561.   TStringGridStrings = class(TStrings)
  562.   private
  563.     FGrid: TStringGrid;
  564.     FIndex: Integer;
  565.     procedure CalcXY(Index: Integer; var X, Y: Integer);
  566.   protected
  567.     procedure Clear; override;
  568.     function Add(const S: string): Integer; override;
  569.     function Get(Index: Integer): string; override;
  570.     function GetCount: Integer; override;
  571.     function GetObject(Index: Integer): TObject; override;
  572.     procedure Put(Index: Integer; const S: string); override;
  573.     procedure PutObject(Index: Integer; AObject: TObject); override;
  574.     procedure SetUpdateState(Updating: Boolean); override;
  575.   public
  576.     constructor Create(AGrid: TStringGrid; AIndex: Longint);
  577.     procedure Assign(Source: TPersistent); override;
  578.     procedure Delete(Index: Integer); override;
  579.     procedure Insert(Index: Integer; const S: string); override;
  580.   end;
  581.  
  582.  
  583.   TStringGrid = class(TDrawGrid)
  584.   private
  585.     FData: Pointer;
  586.     FRows: Pointer;
  587.     FCols: Pointer;
  588.     FUpdating: Boolean;
  589.     FNeedsUpdating: Boolean;
  590.     FEditUpdate: Integer;
  591.     procedure DisableEditUpdate;
  592.     procedure EnableEditUpdate;
  593.     procedure Initialize;
  594.     procedure Update(ACol, ARow: Integer);
  595.     procedure SetUpdateState(Updating: Boolean);
  596.     function GetCells(ACol, ARow: Integer): string;
  597.     function GetCols(Index: Integer): TStrings;
  598.     function GetObjects(ACol, ARow: Integer): TObject;
  599.     function GetRows(Index: Integer): TStrings;
  600.     procedure SetCells(ACol, ARow: Integer; const Value: string);
  601.     procedure SetCols(Index: Integer; Value: TStrings);
  602.     procedure SetObjects(ACol, ARow: Integer; Value: TObject);
  603.     procedure SetRows(Index: Integer; Value: TStrings);
  604.     function EnsureColRow(Index: Integer; IsCol: Boolean): TStringGridStrings;
  605.     function EnsureDataRow(ARow: Integer): Pointer;
  606.   protected
  607.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  608.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  609.       AState: TGridDrawState); override;
  610.     function GetEditText(ACol, ARow: Longint): string; override;
  611.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  612.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  613.   public
  614.     constructor Create(AOwner: TComponent); override;
  615.     destructor Destroy; override;
  616.     property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
  617.     property Cols[Index: Integer]: TStrings read GetCols write SetCols;
  618.     property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
  619.     property Rows[Index: Integer]: TStrings read GetRows write SetRows;
  620.   end;
  621.  
  622. implementation
  623.  
  624. uses Consts;
  625.  
  626. type
  627.   PIntArray = ^TIntArray;
  628.   TIntArray = array[0..MaxCustomExtents] of Integer;
  629.  
  630. procedure InvalidOp(const id: string);
  631. begin
  632.   raise EInvalidGridOperation.Create(id);
  633. end;
  634.  
  635. function IMin(A, B: Integer): Integer;
  636. begin
  637.   Result := B;
  638.   if A < B then Result := A;
  639. end;
  640.  
  641. function IMax(A, B: Integer): Integer;
  642. begin
  643.   Result := B;
  644.   if A > B then Result := A;
  645. end;
  646.  
  647. function GridRect(Coord1, Coord2: TGridCoord): TGridRect;
  648. begin
  649.   with Result do
  650.   begin
  651.     Left := Coord2.X;
  652.     if Coord1.X < Coord2.X then Left := Coord1.X;
  653.     Right := Coord1.X;
  654.     if Coord1.X < Coord2.X then Right := Coord2.X;
  655.     Top := Coord2.Y;
  656.     if Coord1.Y < Coord2.Y then Top := Coord1.Y;
  657.     Bottom := Coord1.Y;
  658.     if Coord1.Y < Coord2.Y then Bottom := Coord2.Y;
  659.   end;
  660. end;
  661.  
  662.  
  663. function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
  664. begin
  665.   Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
  666.     and (Row <= Rect.Bottom);
  667. end;
  668.  
  669. type
  670.   TXorRects = array[0..3] of TRect;
  671.  
  672. procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
  673. var
  674.   Intersect, Union: TRect;
  675.  
  676.   function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
  677.   begin
  678.     with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
  679.       (Y <= Bottom);
  680.   end;
  681.  
  682.   function Includes(const P1: TPoint; var P2: TPoint): Boolean;
  683.   begin
  684.     with P1 do
  685.     begin
  686.       Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
  687.       if Result then P2 := P1;
  688.     end;
  689.   end;
  690.  
  691.   function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
  692.   begin
  693.     Build := True;
  694.     with R do
  695.       if Includes(P1, TopLeft) then
  696.       begin
  697.         if not Includes(P3, BottomRight) then BottomRight := P2;
  698.       end
  699.       else if Includes(P2, TopLeft) then BottomRight := P3
  700.       else Build := False;
  701.   end;
  702.  
  703. begin
  704.   FillChar(XorRects, SizeOf(XorRects), 0);
  705.   if not Bool(IntersectRect(Intersect, R1, R2)) then
  706.   begin
  707.     { Don't intersect so its simple }
  708.     XorRects[0] := R1;
  709.     XorRects[1] := R2;
  710.   end
  711.   else
  712.   begin
  713.     UnionRect(Union, R1, R2);
  714.     if Build(XorRects[0],
  715.       Point(Union.Left, Union.Top),
  716.       Point(Union.Left, Intersect.Top),
  717.       Point(Union.Left, Intersect.Bottom)) then
  718.       XorRects[0].Right := Intersect.Left;
  719.     if Build(XorRects[1],
  720.       Point(Intersect.Left, Union.Top),
  721.       Point(Intersect.Right, Union.Top),
  722.       Point(Union.Right, Union.Top)) then
  723.       XorRects[1].Bottom := Intersect.Top;
  724.     if Build(XorRects[2],
  725.       Point(Union.Right, Intersect.Top),
  726.       Point(Union.Right, Intersect.Bottom),
  727.       Point(Union.Right, Union.Bottom)) then
  728.       XorRects[2].Left := Intersect.Right;
  729.     if Build(XorRects[3],
  730.       Point(Union.Left, Union.Bottom),
  731.       Point(Intersect.Left, Union.Bottom),
  732.       Point(Intersect.Right, Union.Bottom)) then
  733.       XorRects[3].Top := Intersect.Bottom;
  734.   end;
  735. end;
  736.  
  737. procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
  738.   Default: Integer);
  739. var
  740.   LongSize: LongInt;
  741.   NewSize: Cardinal;
  742.   OldSize: Cardinal;
  743.   I: Cardinal;
  744. begin
  745.   if Amount <> 0 then
  746.   begin
  747.     if not Assigned(Extents) then OldSize := 0
  748.     else OldSize := PIntArray(Extents)^[0];
  749.     if (Index < 0) or (OldSize < Index) then InvalidOp(SIndexOutOfRange);
  750.     LongSize := OldSize + Amount;
  751.     if LongSize < 0 then InvalidOp(STooManyDeleted)
  752.     else if LongSize >= MaxListSize - 1 then InvalidOp(SGridTooLarge);
  753.     NewSize := Cardinal(LongSize);
  754.     if NewSize > 0 then Inc(NewSize);
  755.     ReallocMem(Extents, NewSize * SizeOf(Integer));
  756.     if Assigned(Extents) then
  757.     begin
  758.       I := Index;
  759.       while I < NewSize do
  760.       begin
  761.         PIntArray(Extents)^[I] := Default;
  762.         Inc(I);
  763.       end;
  764.       PIntArray(Extents)^[0] := NewSize-1;
  765.     end;
  766.   end;
  767. end;
  768.  
  769. procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
  770.   Default: Integer);
  771. var
  772.   OldSize: Integer;
  773. begin
  774.   OldSize := 0;
  775.   if Assigned(Extents) then OldSize := PIntArray(Extents)^[0];
  776.   ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
  777. end;
  778.  
  779. procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
  780. var
  781.   Extent: Integer;
  782. begin
  783.   if Assigned(Extents) then
  784.   begin
  785.     Extent := PIntArray(Extents)^[FromIndex];
  786.     if FromIndex < ToIndex then
  787.       Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
  788.         (ToIndex - FromIndex) * SizeOf(Integer))
  789.     else if FromIndex > ToIndex then
  790.       Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
  791.         (FromIndex - ToIndex) * SizeOf(Integer));
  792.     PIntArray(Extents)^[ToIndex] := Extent;
  793.   end;
  794. end;
  795.  
  796. function CompareExtents(E1, E2: Pointer): Boolean;
  797. var
  798.   I: Integer;
  799. begin
  800.   Result := False;
  801.   if E1 <> nil then
  802.   begin
  803.     if E2 <> nil then
  804.     begin
  805.       for I := 0 to PIntArray(E1)^[0] do
  806.         if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
  807.       Result := True;
  808.     end
  809.   end
  810.   else Result := E2 = nil;
  811. end;
  812.  
  813. { Private. LongMulDiv multiplys the first two arguments and then
  814.   divides by the third.  This is used so that real number
  815.   (floating point) arithmetic is not necessary.  This routine saves
  816.   the possible 64-bit value in a temp before doing the divide.  Does
  817.   not do error checking like divide by zero.  Also assumes that the
  818.   result is in the 32-bit range (Actually 31-bit, since this algorithm
  819.   is for unsigned). }
  820.  
  821. function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
  822.   external 'kernel32.dll' name 'MulDiv';
  823.  
  824. type
  825.   TSelection = record
  826.     StartPos, EndPos: Integer;
  827.   end;
  828.  
  829. constructor TInplaceEdit.Create(AOwner: TComponent);
  830. begin
  831.   inherited Create(AOwner);
  832.   ParentCtl3D := False;
  833.   Ctl3D := False;
  834.   TabStop := False;
  835.   BorderStyle := bsNone;
  836. end;
  837.  
  838. procedure TInplaceEdit.CreateParams(var Params: TCreateParams);
  839. begin
  840.   inherited CreateParams(Params);
  841.   Params.Style := Params.Style or ES_MULTILINE;
  842. end;
  843.  
  844. procedure TInplaceEdit.SetGrid(Value: TCustomGrid);
  845. begin
  846.   FGrid := Value;
  847. end;
  848.  
  849. procedure TInplaceEdit.CMShowingChanged(var Message: TMessage);
  850. begin
  851.   { Ignore showing using the Visible property }
  852. end;
  853.  
  854. procedure TInplaceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  855. begin
  856.   inherited;
  857.   if goTabs in Grid.Options then
  858.     Message.Result := Message.Result or DLGC_WANTTAB;
  859. end;
  860.  
  861. procedure TInplaceEdit.WMPaste(var Message);
  862. begin
  863.   if not EditCanModify then Exit;
  864.   inherited
  865. end;
  866.  
  867. procedure TInplaceEdit.WMClear(var Message);
  868. begin
  869.   if not EditCanModify then Exit;
  870.   inherited;
  871. end;
  872.  
  873. procedure TInplaceEdit.WMCut(var Message);
  874. begin
  875.   if not EditCanModify then Exit;
  876.   inherited;
  877. end;
  878.  
  879. procedure TInplaceEdit.DblClick;
  880. begin
  881.   Grid.DblClick;
  882. end;
  883.  
  884. function TInplaceEdit.EditCanModify: Boolean;
  885. begin
  886.   Result := Grid.CanEditModify;
  887. end;
  888.  
  889. procedure TInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  890.  
  891.   procedure SendToParent;
  892.   begin
  893.     Grid.KeyDown(Key, Shift);
  894.     Key := 0;
  895.   end;
  896.  
  897.   procedure ParentEvent;
  898.   var
  899.     GridKeyDown: TKeyEvent;
  900.   begin
  901.     GridKeyDown := Grid.OnKeyDown;
  902.     if Assigned(GridKeyDown) then GridKeyDown(Grid, Key, Shift);
  903.   end;
  904.  
  905.   function ForwardMovement: Boolean;
  906.   begin
  907.     Result := goAlwaysShowEditor in Grid.Options;
  908.   end;
  909.  
  910.   function Ctrl: Boolean;
  911.   begin
  912.     Result := ssCtrl in Shift;
  913.   end;
  914.  
  915.   function Selection: TSelection;
  916.   begin
  917.     SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
  918.   end;
  919.  
  920.   function RightSide: Boolean;
  921.   begin
  922.     with Selection do
  923.       Result := ((StartPos = 0) or (EndPos = StartPos)) and
  924.         (EndPos = GetTextLen);
  925.    end;
  926.  
  927.   function LeftSide: Boolean;
  928.   begin
  929.     with Selection do
  930.       Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = GetTextLen));
  931.   end;
  932.  
  933. begin
  934.   case Key of
  935.     VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_ESCAPE: SendToParent;
  936.     VK_INSERT:
  937.       if Shift = [] then SendToParent
  938.       else if (Shift = [ssShift]) and not Grid.CanEditModify then Key := 0;
  939.     VK_LEFT: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  940.     VK_RIGHT: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  941.     VK_HOME: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  942.     VK_END: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  943.     VK_F2:
  944.       begin
  945.         ParentEvent;
  946.         if Key = VK_F2 then
  947.         begin
  948.           Deselect;
  949.           Exit;
  950.         end;
  951.       end;
  952.     VK_TAB: if not (ssAlt in Shift) then SendToParent;
  953.   end;
  954.   if (Key = VK_DELETE) and not Grid.CanEditModify then Key := 0;
  955.   if Key <> 0 then
  956.   begin
  957.     ParentEvent;
  958.     inherited KeyDown(Key, Shift);
  959.   end;
  960. end;
  961.  
  962. procedure TInplaceEdit.KeyPress(var Key: Char);
  963. var
  964.   Selection: TSelection;
  965. begin
  966.   Grid.KeyPress(Key);
  967.   if (Key in [#32..#255]) and not Grid.CanEditAcceptKey(Key) then
  968.   begin
  969.     Key := #0;
  970.     MessageBeep(0);
  971.   end;
  972.   case Key of
  973.     #9, #27: Key := #0;
  974.     #13:
  975.       begin
  976.         SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  977.         if (Selection.StartPos = 0) and (Selection.EndPos = GetTextLen) then
  978.           Deselect else
  979.           SelectAll;
  980.         Key := #0;
  981.       end;
  982.     ^H, ^V, ^X, #32..#255:
  983.       if not Grid.CanEditModify then Key := #0;
  984.   end;
  985.   if Key <> #0 then inherited KeyPress(Key);
  986. end;
  987.  
  988. procedure TInplaceEdit.KeyUp(var Key: Word; Shift: TShiftState);
  989. begin
  990.   Grid.KeyUp(Key, Shift);
  991. end;
  992.  
  993. procedure TInplaceEdit.WndProc(var Message: TMessage);
  994. begin
  995.   case Message.Msg of
  996.     WM_SETFOCUS:
  997.       begin
  998.         if GetParentForm(Self).SetFocusedControl(Grid) then Dispatch(Message);
  999.         Exit;
  1000.       end;
  1001.     WM_LBUTTONDOWN:
  1002.       begin
  1003.         if GetMessageTime - FClickTime < GetDoubleClickTime then
  1004.           Message.Msg := WM_LBUTTONDBLCLK;
  1005.         FClickTime := 0;
  1006.       end;
  1007.   end;
  1008.   inherited WndProc(Message);
  1009. end;
  1010.  
  1011. procedure TInplaceEdit.Deselect;
  1012. begin
  1013.   SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
  1014. end;
  1015.  
  1016. procedure TInplaceEdit.Invalidate;
  1017. var
  1018.   Cur: TRect;
  1019. begin
  1020.   ValidateRect(Handle, nil);
  1021.   InvalidateRect(Handle, nil, True);
  1022.   Windows.GetClientRect(Handle, Cur);
  1023.   MapWindowPoints(Handle, Grid.Handle, Cur, 2);
  1024.   ValidateRect(Grid.Handle, @Cur);
  1025.   InvalidateRect(Grid.Handle, @Cur, False);
  1026. end;
  1027.  
  1028. procedure TInplaceEdit.Hide;
  1029. begin
  1030.   if HandleAllocated and IsWindowVisible(Handle) then
  1031.   begin
  1032.     Invalidate;
  1033.     SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW or SWP_NOZORDER or
  1034.       SWP_NOREDRAW);
  1035.     if Focused then Windows.SetFocus(Grid.Handle);
  1036.   end;
  1037. end;
  1038.  
  1039. function TInplaceEdit.PosEqual(const Rect: TRect): Boolean;
  1040. var
  1041.   Cur: TRect;
  1042. begin
  1043.   GetWindowRect(Handle, Cur);
  1044.   MapWindowPoints(HWND_DESKTOP, Grid.Handle, Cur, 2);
  1045.   Result := EqualRect(Rect, Cur);
  1046. end;
  1047.  
  1048. procedure TInplaceEdit.InternalMove(const Loc: TRect; Redraw: Boolean);
  1049. begin
  1050.   if IsRectEmpty(Loc) then Hide
  1051.   else
  1052.   begin
  1053.     CreateHandle;
  1054.     Redraw := Redraw or not IsWindowVisible(Handle);
  1055.     Invalidate;
  1056.     with Loc do
  1057.       SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top,
  1058.         SWP_SHOWWINDOW or SWP_NOREDRAW);
  1059.     BoundsChanged;
  1060.     if Redraw then Invalidate;
  1061.     if Grid.Focused then
  1062.       Windows.SetFocus(Handle);
  1063.   end;
  1064. end;
  1065.  
  1066. procedure TInplaceEdit.BoundsChanged;
  1067. var
  1068.   R: TRect;
  1069. begin
  1070.   R := Rect(2, 2, Width - 2, Height);
  1071.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  1072.   SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  1073. end;
  1074.  
  1075. procedure TInplaceEdit.UpdateLoc(const Loc: TRect);
  1076. begin
  1077.   InternalMove(Loc, False);
  1078. end;
  1079.  
  1080. function TInplaceEdit.Visible: Boolean;
  1081. begin
  1082.   Result := IsWindowVisible(Handle);
  1083. end;
  1084.  
  1085. procedure TInplaceEdit.Move(const Loc: TRect);
  1086. begin
  1087.   InternalMove(Loc, True);
  1088. end;
  1089.  
  1090. procedure TInplaceEdit.SetFocus;
  1091. begin
  1092.   if IsWindowVisible(Handle) then
  1093.     Windows.SetFocus(Handle);
  1094. end;
  1095.  
  1096. procedure TInplaceEdit.UpdateContents;
  1097. begin
  1098.   Text := '';
  1099.   EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
  1100.   Text := Grid.GetEditText(Grid.Col, Grid.Row);
  1101.   MaxLength := Grid.GetEditLimit;
  1102. end;
  1103.  
  1104. { TCustomGrid }
  1105.  
  1106. constructor TCustomGrid.Create(AOwner: TComponent);
  1107. const
  1108.   GridStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
  1109. begin
  1110.   inherited Create(AOwner);
  1111.   if NewStyleControls then
  1112.     ControlStyle := GridStyle else
  1113.     ControlStyle := GridStyle + [csFramed];
  1114.   FCanEditModify := True;
  1115.   FColCount := 5;
  1116.   FRowCount := 5;
  1117.   FFixedCols := 1;
  1118.   FFixedRows := 1;
  1119.   FGridLineWidth := 1;
  1120.   FOptions := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  1121.     goRangeSelect];
  1122.   DesignOptionsBoost := [goColSizing, goRowSizing];
  1123.   FFixedColor := clBtnFace;
  1124.   FScrollBars := ssBoth;
  1125.   FBorderStyle := bsSingle;
  1126.   FDefaultColWidth := 64;
  1127.   FDefaultRowHeight := 24;
  1128.   FDefaultDrawing := True;
  1129.   FSaveCellExtents := True;
  1130.   FEditorMode := False;
  1131.   Color := clWindow;
  1132.   ParentColor := False;
  1133.   TabStop := True;
  1134.   SetBounds(Left, Top, FColCount * FDefaultColWidth,
  1135.     FRowCount * FDefaultRowHeight);
  1136.   Initialize;
  1137. end;
  1138.  
  1139. destructor TCustomGrid.Destroy;
  1140. begin
  1141.   FInplaceEdit.Free;
  1142.   inherited Destroy;
  1143.   FreeMem(FColWidths);
  1144.   FreeMem(FRowHeights);
  1145.   FreeMem(FTabStops);
  1146. end;
  1147.  
  1148. procedure TCustomGrid.AdjustSize(Index, Amount: Longint; Rows: Boolean);
  1149. var
  1150.   NewCur: TGridCoord;
  1151.   OldRows, OldCols: Longint;
  1152.   MovementX, MovementY: Longint;
  1153.   MoveRect: TGridRect;
  1154.   ScrollArea: TRect;
  1155.   AbsAmount: Longint;
  1156.  
  1157.   function DoSizeAdjust(var Count: Longint; var Extents: Pointer;
  1158.     DefaultExtent: Integer; var Current: Longint): Longint;
  1159.   var
  1160.     I: Integer;
  1161.     NewCount: Longint;
  1162.   begin
  1163.     NewCount := Count + Amount;
  1164.     if NewCount < Index then InvalidOp(STooManyDeleted);
  1165.     if (Amount < 0) and Assigned(Extents) then
  1166.     begin
  1167.       Result := 0;
  1168.       for I := Index to Index - Amount - 1 do
  1169.         Inc(Result, PIntArray(Extents)^[I]);
  1170.     end
  1171.     else
  1172.       Result := Amount * DefaultExtent;
  1173.     if Extents <> nil then
  1174.       ModifyExtents(Extents, Index, Amount, DefaultExtent);
  1175.     Count := NewCount;
  1176.     if Current >= Index then
  1177.       if (Amount < 0) and (Current < Index - Amount) then Current := Index
  1178.       else Inc(Current, Amount);
  1179.   end;
  1180.  
  1181. begin
  1182.   if Amount = 0 then Exit;
  1183.   NewCur := FCurrent;
  1184.   OldCols := ColCount;
  1185.   OldRows := RowCount;
  1186.   MoveRect.Left := FixedCols;
  1187.   MoveRect.Right := ColCount - 1;
  1188.   MoveRect.Top := FixedRows;
  1189.   MoveRect.Bottom := RowCount - 1;
  1190.   MovementX := 0;
  1191.   MovementY := 0;
  1192.   AbsAmount := Amount;
  1193.   if AbsAmount < 0 then AbsAmount := -AbsAmount;
  1194.   if Rows then
  1195.   begin
  1196.     MovementY := DoSizeAdjust(FRowCount, FRowHeights, DefaultRowHeight, NewCur.Y);
  1197.     MoveRect.Top := Index;
  1198.     if Index + AbsAmount <= TopRow then MoveRect.Bottom := TopRow - 1;
  1199.   end
  1200.   else
  1201.   begin
  1202.     MovementX := DoSizeAdjust(FColCount, FColWidths, DefaultColWidth, NewCur.X);
  1203.     MoveRect.Left := Index;
  1204.     if Index + AbsAmount <= LeftCol then MoveRect.Right := LeftCol - 1;
  1205.   end;
  1206.   GridRectToScreenRect(MoveRect, ScrollArea, True);
  1207.   if not IsRectEmpty(ScrollArea) then
  1208.   begin
  1209.     ScrollWindow(Handle, MovementX, MovementY, @ScrollArea, @ScrollArea);
  1210.     UpdateWindow(Handle);
  1211.   end;
  1212.   SizeChanged(OldCols, OldRows);
  1213.   if (NewCur.X <> FCurrent.X) or (NewCur.Y <> FCurrent.Y) then
  1214.     MoveCurrent(NewCur.X, NewCur.Y, True, True);
  1215. end;
  1216.  
  1217. function TCustomGrid.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  1218. var
  1219.   GridRect: TGridRect;
  1220. begin
  1221.   GridRect.Left := ALeft;
  1222.   GridRect.Right := ARight;
  1223.   GridRect.Top := ATop;
  1224.   GridRect.Bottom := ABottom;
  1225.   GridRectToScreenRect(GridRect, Result, False);
  1226. end;
  1227.  
  1228. procedure TCustomGrid.DoExit;
  1229. begin
  1230.   inherited DoExit;
  1231.   if not (goAlwaysShowEditor in Options) then HideEditor;
  1232. end;
  1233.  
  1234. function TCustomGrid.CellRect(ACol, ARow: Longint): TRect;
  1235. begin
  1236.   Result := BoxRect(ACol, ARow, ACol, ARow);
  1237. end;
  1238.  
  1239. function TCustomGrid.CanEditAcceptKey(Key: Char): Boolean;
  1240. begin
  1241.   Result := True;
  1242. end;
  1243.  
  1244. function TCustomGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
  1245. begin
  1246.   Result := True;
  1247. end;
  1248.  
  1249. function TCustomGrid.CanEditModify: Boolean;
  1250. begin
  1251.   Result := FCanEditModify;
  1252. end;
  1253.  
  1254. function TCustomGrid.CanEditShow: Boolean;
  1255. begin
  1256.   Result := ([goRowSelect, goEditing] * Options = [goEditing]) and
  1257.     FEditorMode and not (csDesigning in ComponentState) and HandleAllocated and
  1258.     ((goAlwaysShowEditor in Options) or (ValidParentForm(Self).ActiveControl = Self));
  1259. end;
  1260.  
  1261. function TCustomGrid.GetEditMask(ACol, ARow: Longint): string;
  1262. begin
  1263.   Result := '';
  1264. end;
  1265.  
  1266. function TCustomGrid.GetEditText(ACol, ARow: Longint): string;
  1267. begin
  1268.   Result := '';
  1269. end;
  1270.  
  1271. procedure TCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  1272. begin
  1273. end;
  1274.  
  1275. function TCustomGrid.GetEditLimit: Integer;
  1276. begin
  1277.   Result := 0;
  1278. end;
  1279.  
  1280. procedure TCustomGrid.HideEditor;
  1281. begin
  1282.   FEditorMode := False;
  1283.   HideEdit;
  1284. end;
  1285.  
  1286. procedure TCustomGrid.ShowEditor;
  1287. begin
  1288.   FEditorMode := True;
  1289.   UpdateEdit;
  1290. end;
  1291.  
  1292. procedure TCustomGrid.ShowEditorChar(Ch: Char);
  1293. begin
  1294.   ShowEditor;
  1295.   if FInplaceEdit <> nil then
  1296.     PostMessage(FInplaceEdit.Handle, WM_CHAR, Word(Ch), 0);
  1297. end;
  1298.  
  1299. procedure TCustomGrid.InvalidateEditor;
  1300. begin
  1301.   FInplaceCol := -1;
  1302.   FInplaceRow := -1;
  1303.   UpdateEdit;
  1304. end;
  1305.  
  1306. procedure TCustomGrid.ReadColWidths(Reader: TReader);
  1307. var
  1308.   I: Integer;
  1309. begin
  1310.   with Reader do
  1311.   begin
  1312.     ReadListBegin;
  1313.     for I := 0 to ColCount - 1 do ColWidths[I] := ReadInteger;
  1314.     ReadListEnd;
  1315.   end;
  1316. end;
  1317.  
  1318. procedure TCustomGrid.ReadRowHeights(Reader: TReader);
  1319. var
  1320.   I: Integer;
  1321. begin
  1322.   with Reader do
  1323.   begin
  1324.     ReadListBegin;
  1325.     for I := 0 to RowCount - 1 do RowHeights[I] := ReadInteger;
  1326.     ReadListEnd;
  1327.   end;
  1328. end;
  1329.  
  1330. procedure TCustomGrid.WriteColWidths(Writer: TWriter);
  1331. var
  1332.   I: Integer;
  1333. begin
  1334.   with Writer do
  1335.   begin
  1336.     WriteListBegin;
  1337.     for I := 0 to ColCount - 1 do WriteInteger(ColWidths[I]);
  1338.     WriteListEnd;
  1339.   end;
  1340. end;
  1341.  
  1342. procedure TCustomGrid.WriteRowHeights(Writer: TWriter);
  1343. var
  1344.   I: Integer;
  1345. begin
  1346.   with Writer do
  1347.   begin
  1348.     WriteListBegin;
  1349.     for I := 0 to RowCount - 1 do WriteInteger(RowHeights[I]);
  1350.     WriteListEnd;
  1351.   end;
  1352. end;
  1353.  
  1354. procedure TCustomGrid.DefineProperties(Filer: TFiler);
  1355.  
  1356.   function DoColWidths: Boolean;
  1357.   begin
  1358.     if Filer.Ancestor <> nil then
  1359.       Result := not CompareExtents(TCustomGrid(Filer.Ancestor).FColWidths, FColWidths)
  1360.     else
  1361.       Result := FColWidths <> nil;
  1362.   end;
  1363.  
  1364.   function DoRowHeights: Boolean;
  1365.   begin
  1366.     if Filer.Ancestor <> nil then
  1367.       Result := not CompareExtents(TCustomGrid(Filer.Ancestor).FRowHeights, FRowHeights)
  1368.     else
  1369.       Result := FRowHeights <> nil;
  1370.   end;
  1371.  
  1372.  
  1373. begin
  1374.   inherited DefineProperties(Filer);
  1375.   if FSaveCellExtents then
  1376.     with Filer do
  1377.     begin
  1378.       DefineProperty('ColWidths', ReadColWidths, WriteColWidths, DoColWidths);
  1379.       DefineProperty('RowHeights', ReadRowHeights, WriteRowHeights, DoRowHeights);
  1380.     end;
  1381. end;
  1382.  
  1383. procedure TCustomGrid.MoveColumn(FromIndex, ToIndex: Longint);
  1384. var
  1385.   Rect: TGridRect;
  1386. begin
  1387.   if FromIndex = ToIndex then Exit;
  1388.   if Assigned(FColWidths) then
  1389.   begin
  1390.     MoveExtent(FColWidths, FromIndex + 1, ToIndex + 1);
  1391.     MoveExtent(FTabStops, FromIndex + 1, ToIndex + 1);
  1392.   end;
  1393.   MoveAdjust(FCurrent.X, FromIndex, ToIndex);
  1394.   MoveAdjust(FAnchor.X, FromIndex, ToIndex);
  1395.   MoveAdjust(FInplaceCol, FromIndex, ToIndex);
  1396.   Rect.Top := 0;
  1397.   Rect.Bottom := VisibleRowCount;
  1398.   if FromIndex < ToIndex then
  1399.   begin
  1400.     Rect.Left := FromIndex;
  1401.     Rect.Right := ToIndex;
  1402.   end
  1403.   else
  1404.   begin
  1405.     Rect.Left := ToIndex;
  1406.     Rect.Right := FromIndex;
  1407.   end;
  1408.   InvalidateRect(Rect);
  1409.   ColumnMoved(FromIndex, ToIndex);
  1410.   if Assigned(FColWidths) then
  1411.     ColWidthsChanged;
  1412.   UpdateEdit;
  1413. end;
  1414.  
  1415. procedure TCustomGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  1416. begin
  1417. end;
  1418.  
  1419. procedure TCustomGrid.MoveRow(FromIndex, ToIndex: Longint);
  1420. begin
  1421.   if Assigned(FRowHeights) then
  1422.     MoveExtent(FRowHeights, FromIndex + 1, ToIndex + 1);
  1423.   MoveAdjust(FCurrent.Y, FromIndex, ToIndex);
  1424.   MoveAdjust(FAnchor.Y, FromIndex, ToIndex);
  1425.   MoveAdjust(FInplaceRow, FromIndex, ToIndex);
  1426.   RowMoved(FromIndex, ToIndex);
  1427.   if Assigned(FRowHeights) then
  1428.     RowHeightsChanged;
  1429.   UpdateEdit;
  1430. end;
  1431.  
  1432. procedure TCustomGrid.RowMoved(FromIndex, ToIndex: Longint);
  1433. begin
  1434. end;
  1435.  
  1436. function TCustomGrid.MouseCoord(X, Y: Integer): TGridCoord;
  1437. var
  1438.   DrawInfo: TGridDrawInfo;
  1439. begin
  1440.   CalcDrawInfo(DrawInfo);
  1441.   Result := CalcCoordFromPoint(X, Y, DrawInfo);
  1442.   if Result.X < 0 then Result.Y := -1
  1443.   else if Result.Y < 0 then Result.X := -1;
  1444. end;
  1445.  
  1446. procedure TCustomGrid.MoveColRow(ACol, ARow: Longint; MoveAnchor,
  1447.   Show: Boolean);
  1448. begin
  1449.   MoveCurrent(ACol, ARow, MoveAnchor, Show);
  1450. end;
  1451.  
  1452. function TCustomGrid.SelectCell(ACol, ARow: Longint): Boolean;
  1453. begin
  1454.   Result := True;
  1455. end;
  1456.  
  1457. procedure TCustomGrid.SizeChanged(OldColCount, OldRowCount: Longint);
  1458. begin
  1459. end;
  1460.  
  1461. function TCustomGrid.Sizing(X, Y: Integer): Boolean;
  1462. var
  1463.   FixedInfo: TGridDrawInfo;
  1464.   State: TGridState;
  1465.   Index: Longint;
  1466.   Pos, Ofs: Integer;
  1467. begin
  1468.   State := FGridState;
  1469.   if State = gsNormal then
  1470.   begin
  1471.     CalcFixedInfo(FixedInfo);
  1472.     CalcSizingState(X, Y, State, Index, Pos, Ofs, FixedInfo);
  1473.   end;
  1474.   Result := State <> gsNormal;
  1475. end;
  1476.  
  1477. procedure TCustomGrid.TopLeftChanged;
  1478. begin
  1479.   if FEditorMode and (FInplaceEdit <> nil) then FInplaceEdit.UpdateLoc(CellRect(Col, Row));
  1480. end;
  1481.  
  1482. procedure FillDWord(var Dest; Count, Value: Integer); register;
  1483. asm
  1484.   XCHG  EDX, ECX
  1485.   PUSH  EDI
  1486.   MOV   EDI, EAX
  1487.   MOV   EAX, EDX
  1488.   REP   STOSD
  1489.   POP   EDI
  1490. end;
  1491.  
  1492. { StackAlloc allocates a 'small' block of memory from the stack by
  1493.   decrementing SP.  This provides the allocation speed of a local variable,
  1494.   but the runtime size flexibility of heap allocated memory.  }
  1495. function StackAlloc(Size: Integer): Pointer; register;
  1496. asm
  1497.   POP   ECX          { return address }
  1498.   MOV   EDX, ESP
  1499.   SUB   ESP, EAX
  1500.   MOV   EAX, ESP     { function result = low memory address of block }
  1501.   PUSH  EDX          { save original SP, for cleanup }
  1502.   MOV   EDX, ESP
  1503.   SUB   EDX, 4
  1504.   PUSH  EDX          { save current SP, for sanity check  (sp = [sp]) }
  1505.   PUSH  ECX          { return to caller }
  1506. end;
  1507.  
  1508. { StackFree pops the memory allocated by StackAlloc off the stack.
  1509. - Calling StackFree is optional - SP will be restored when the calling routine
  1510.   exits, but it's a good idea to free the stack allocated memory ASAP anyway.
  1511. - StackFree must be called in the same stack context as StackAlloc - not in
  1512.   a subroutine or finally block.
  1513. - Multiple StackFree calls must occur in reverse order of their corresponding
  1514.   StackAlloc calls.
  1515. - Built-in sanity checks guarantee that an improper call to StackFree will not
  1516.   corrupt the stack. Worst case is that the stack block is not released until
  1517.   the calling routine exits. }
  1518. procedure StackFree(P: Pointer); register;
  1519. asm
  1520.   POP   ECX                     { return address }
  1521.   MOV   EDX, DWORD PTR [ESP]
  1522.   SUB   EAX, 8
  1523.   CMP   EDX, ESP                { sanity check #1 (SP = [SP]) }
  1524.   JNE   @@1
  1525.   CMP   EDX, EAX                { sanity check #2 (P = this stack block) }
  1526.   JNE   @@1
  1527.   MOV   ESP, DWORD PTR [ESP+4]  { restore previous SP  }
  1528. @@1:
  1529.   PUSH  ECX                     { return to caller }
  1530. end;
  1531.  
  1532. procedure TCustomGrid.Paint;
  1533. var
  1534.   LineColor: TColor;
  1535.   DrawInfo: TGridDrawInfo;
  1536.   Sel: TGridRect;
  1537.   UpdateRect: TRect;
  1538.   FocRect: TRect;
  1539.   PointsList: PIntArray;
  1540.   StrokeList: PIntArray;
  1541.   MaxStroke: Integer;
  1542.   FrameFlags1, FrameFlags2: DWORD;
  1543.  
  1544.   procedure DrawLines(DoHorz, DoVert: Boolean; Col, Row: Longint;
  1545.     const CellBounds: array of Integer; OnColor, OffColor: TColor);
  1546.  
  1547.   { Cellbounds is 4 integers: StartX, StartY, StopX, StopY
  1548.     Horizontal lines:  MajorIndex = 0
  1549.     Vertical lines:    MajorIndex = 1 }
  1550.  
  1551.   const
  1552.     FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;
  1553.  
  1554.     procedure DrawAxisLines(const AxisInfo: TGridAxisDrawInfo;
  1555.       Cell, MajorIndex: Integer; UseOnColor: Boolean);
  1556.     var
  1557.       Line: Integer;
  1558.       LogBrush: TLOGBRUSH;
  1559.       Index: Integer;
  1560.       Points: PIntArray;
  1561.       StopMajor, StartMinor, StopMinor: Integer;
  1562.     begin
  1563.       with Canvas, AxisInfo do
  1564.       begin
  1565.         if EffectiveLineWidth <> 0 then
  1566.         begin
  1567.           Pen.Width := GridLineWidth;
  1568.           if UseOnColor then
  1569.             Pen.Color := OnColor
  1570.           else
  1571.             Pen.Color := OffColor;
  1572.           if Pen.Width > 1 then
  1573.           begin
  1574.             LogBrush.lbStyle := BS_Solid;
  1575.             LogBrush.lbColor := Pen.Color;
  1576.             LogBrush.lbHatch := 0;
  1577.             Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
  1578.           end;
  1579.           Points := PointsList;
  1580.           Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
  1581.             GetExtent(Cell);
  1582.           StartMinor := CellBounds[MajorIndex xor 1];
  1583.           StopMinor := CellBounds[2 + (MajorIndex xor 1)];
  1584.           StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
  1585.           Index := 0;
  1586.           repeat
  1587.             Points^[Index + MajorIndex] := Line;         { MoveTo }
  1588.             Points^[Index + (MajorIndex xor 1)] := StartMinor;
  1589.             Inc(Index, 2);
  1590.             Points^[Index + MajorIndex] := Line;         { LineTo }
  1591.             Points^[Index + (MajorIndex xor 1)] := StopMinor;
  1592.             Inc(Index, 2);
  1593.             Inc(Cell);
  1594.             Inc(Line, GetExtent(Cell) + EffectiveLineWidth);
  1595.           until Line > StopMajor;
  1596.            { 2 integers per point, 2 points per line -> Index div 4 }
  1597.           PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
  1598.         end;
  1599.       end;
  1600.     end;
  1601.  
  1602.   begin
  1603.     if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then Exit;
  1604.     if not DoHorz then
  1605.     begin
  1606.       DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
  1607.       DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
  1608.     end
  1609.     else
  1610.     begin
  1611.       DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
  1612.       DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
  1613.     end;
  1614.   end;
  1615.  
  1616.   procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
  1617.     Color: TColor; IncludeDrawState: TGridDrawState);
  1618.   var
  1619.     CurCol, CurRow: Longint;
  1620.     Where, TempRect: TRect;
  1621.     DrawState: TGridDrawState;
  1622.     Focused: Boolean;
  1623.     PF: TCustomForm;
  1624.   begin
  1625.     CurRow := ARow;
  1626.     Where.Top := StartY;
  1627.     while (Where.Top < StopY) and (CurRow < RowCount) do
  1628.     begin
  1629.       CurCol := ACol;
  1630.       Where.Left := StartX;
  1631.       Where.Bottom := Where.Top + RowHeights[CurRow];
  1632.       while (Where.Left < StopX) and (CurCol < ColCount) do
  1633.       begin
  1634.         Where.Right := Where.Left + ColWidths[CurCol];
  1635.         if RectVisible(Canvas.Handle, Where) then
  1636.         begin
  1637.           DrawState := IncludeDrawState;
  1638.           PF := GetParentForm(Self);
  1639.           Focused := (PF <> nil) and (PF.ActiveControl = Self);
  1640.           if Focused and (CurRow = Row) and (CurCol = Col)  then
  1641.             Include(DrawState, gdFocused);
  1642.           if PointInGridRect(CurCol, CurRow, Sel) then
  1643.             Include(DrawState, gdSelected);
  1644.           if not (gdFocused in DrawState) or not (goEditing in Options) or
  1645.             not FEditorMode or (csDesigning in ComponentState) then
  1646.           begin
  1647.             if DefaultDrawing or (csDesigning in ComponentState) then
  1648.               with Canvas do
  1649.               begin
  1650.                 Font := Self.Font;
  1651.                 if (gdSelected in DrawState) and
  1652.                   (not (gdFocused in DrawState) or
  1653.                   ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
  1654.                 begin
  1655.                   Brush.Color := clHighlight;
  1656.                   Font.Color := clHighlightText;
  1657.                 end
  1658.                 else
  1659.                   Brush.Color := Color;
  1660.                 FillRect(Where);
  1661.               end;
  1662.             DrawCell(CurCol, CurRow, Where, DrawState);
  1663.             if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
  1664.               ((FrameFlags1 or FrameFlags2) <> 0) then
  1665.             begin
  1666.               TempRect := Where;
  1667.               if (FrameFlags1 and BF_RIGHT) = 0 then
  1668.                 Inc(TempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
  1669.               else if (FrameFlags1 and BF_BOTTOM) = 0 then
  1670.                 Inc(TempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
  1671.               DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1);
  1672.               DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2);
  1673.             end;
  1674.             if DefaultDrawing and not (csDesigning in ComponentState) and
  1675.               (gdFocused in DrawState) and
  1676.               ([goEditing, goAlwaysShowEditor] * Options <>
  1677.               [goEditing, goAlwaysShowEditor])
  1678.               and not (goRowSelect in Options) then
  1679.               DrawFocusRect(Canvas.Handle, Where);
  1680.           end;
  1681.         end;
  1682.         Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
  1683.         Inc(CurCol);
  1684.       end;
  1685.       Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
  1686.       Inc(CurRow);
  1687.     end;
  1688.   end;
  1689.  
  1690. begin
  1691.   UpdateRect := Canvas.ClipRect;
  1692.   CalcDrawInfo(DrawInfo);
  1693.   with DrawInfo do
  1694.   begin
  1695.     if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then
  1696.     begin
  1697.       { Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
  1698.         (fixed, variable) and (variable, variable) }
  1699.       LineColor := clSilver;
  1700.       MaxStroke := IMax(Horz.LastFullVisibleCell - LeftCol + FixedCols,
  1701.                         Vert.LastFullVisibleCell - TopRow + FixedRows) + 3;
  1702.       PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
  1703.       StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
  1704.       FillDWord(StrokeList^, MaxStroke, 2);
  1705.  
  1706.       if ColorToRGB(Color) = clSilver then LineColor := clGray;
  1707.       DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1708.         0, 0, [0, 0, Horz.FixedBoundary, Vert.FixedBoundary], clBlack, FixedColor);
  1709.       DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1710.         LeftCol, 0, [Horz.FixedBoundary, 0, Horz.GridBoundary,
  1711.         Vert.FixedBoundary], clBlack, FixedColor);
  1712.       DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1713.         0, TopRow, [0, Vert.FixedBoundary, Horz.FixedBoundary,
  1714.         Vert.GridBoundary], clBlack, FixedColor);
  1715.       DrawLines(goHorzLine in Options, goVertLine in Options, LeftCol,
  1716.         TopRow, [Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridBoundary,
  1717.         Vert.GridBoundary], LineColor, Color);
  1718.  
  1719.       StackFree(StrokeList);
  1720.       StackFree(PointsList);
  1721.     end;
  1722.  
  1723.     { Draw the cells in the four areas }
  1724.     Sel := Selection;
  1725.     FrameFlags1 := 0;
  1726.     FrameFlags2 := 0;
  1727.     if goFixedVertLine in Options then
  1728.     begin
  1729.       FrameFlags1 := BF_RIGHT;
  1730.       FrameFlags2 := BF_LEFT;
  1731.     end;
  1732.     if goFixedHorzLine in Options then
  1733.     begin
  1734.       FrameFlags1 := FrameFlags1 or BF_BOTTOM;
  1735.       FrameFlags2 := FrameFlags2 or BF_TOP;
  1736.     end;
  1737.     DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, FixedColor,
  1738.       [gdFixed]);
  1739.     DrawCells(LeftCol, 0, Horz.FixedBoundary - FColOffset, 0, Horz.GridBoundary,
  1740.       Vert.FixedBoundary, FixedColor, [gdFixed]);
  1741.     DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary,
  1742.       Vert.GridBoundary, FixedColor, [gdFixed]);
  1743.     DrawCells(LeftCol, TopRow, Horz.FixedBoundary - FColOffset,
  1744.       Vert.FixedBoundary, Horz.GridBoundary, Vert.GridBoundary, Color, []);
  1745.  
  1746.     if not (csDesigning in ComponentState) and
  1747.       (goRowSelect in Options) and DefaultDrawing and Focused then
  1748.     begin
  1749.       GridRectToScreenRect(GetSelection, FocRect, False);
  1750.       Canvas.DrawFocusRect(FocRect);
  1751.     end;
  1752.  
  1753.     { Fill in area not occupied by cells }
  1754.     if Horz.GridBoundary < Horz.GridExtent then
  1755.     begin
  1756.       Canvas.Brush.Color := Color;
  1757.       Canvas.FillRect(Rect(Horz.GridBoundary, 0, Horz.GridExtent, Vert.GridBoundary));
  1758.     end;
  1759.     if Vert.GridBoundary < Vert.GridExtent then
  1760.     begin
  1761.       Canvas.Brush.Color := Color;
  1762.       Canvas.FillRect(Rect(0, Vert.GridBoundary, Horz.GridExtent, Vert.GridExtent));
  1763.     end;
  1764.   end;
  1765. end;
  1766.  
  1767. function TCustomGrid.CalcCoordFromPoint(X, Y: Integer;
  1768.   const DrawInfo: TGridDrawInfo): TGridCoord;
  1769.  
  1770.   function DoCalc(const AxisInfo: TGridAxisDrawInfo; N: Integer): Integer;
  1771.   var
  1772.     I, Start, Stop: Longint;
  1773.     Line: Integer;
  1774.   begin
  1775.     with AxisInfo do
  1776.     begin
  1777.       if N < FixedBoundary then
  1778.       begin
  1779.         Start := 0;
  1780.         Stop :=  FixedCellCount - 1;
  1781.         Line := 0;
  1782.       end
  1783.       else
  1784.       begin
  1785.         Start := FirstGridCell;
  1786.         Stop := GridCellCount - 1;
  1787.         Line := FixedBoundary;
  1788.       end;
  1789.       Result := -1;
  1790.       for I := Start to Stop do
  1791.       begin
  1792.         Inc(Line, GetExtent(I) + EffectiveLineWidth);
  1793.         if N < Line then
  1794.         begin
  1795.           Result := I;
  1796.           Exit;
  1797.         end;
  1798.       end;
  1799.     end;
  1800.   end;
  1801.  
  1802. begin
  1803.   Result.X := DoCalc(DrawInfo.Horz, X);
  1804.   Result.Y := DoCalc(DrawInfo.Vert, Y);
  1805. end;
  1806.  
  1807. procedure TCustomGrid.CalcDrawInfo(var DrawInfo: TGridDrawInfo);
  1808. begin
  1809.   CalcDrawInfoXY(DrawInfo, ClientWidth, ClientHeight);
  1810. end;
  1811.  
  1812. procedure TCustomGrid.CalcDrawInfoXY(var DrawInfo: TGridDrawInfo;
  1813.   UseWidth, UseHeight: Integer);
  1814.  
  1815.   procedure CalcAxis(var AxisInfo: TGridAxisDrawInfo; UseExtent: Integer);
  1816.   var
  1817.     I: Integer;
  1818.   begin
  1819.     with AxisInfo do
  1820.     begin
  1821.       GridExtent := UseExtent;
  1822.       GridBoundary := FixedBoundary;
  1823.       FullVisBoundary := FixedBoundary;
  1824.       LastFullVisibleCell := FirstGridCell;
  1825.       for I := FirstGridCell to GridCellCount - 1 do
  1826.       begin
  1827.         Inc(GridBoundary, GetExtent(I) + EffectiveLineWidth);
  1828.         if GridBoundary > GridExtent + EffectiveLineWidth then
  1829.         begin
  1830.           GridBoundary := GridExtent;
  1831.           Break;
  1832.         end;
  1833.         LastFullVisibleCell := I;
  1834.         FullVisBoundary := GridBoundary;
  1835.       end;
  1836.     end;
  1837.   end;
  1838.  
  1839. begin
  1840.   CalcFixedInfo(DrawInfo);
  1841.   CalcAxis(DrawInfo.Horz, UseWidth);
  1842.   CalcAxis(DrawInfo.Vert, UseHeight);
  1843. end;
  1844.  
  1845. procedure TCustomGrid.CalcFixedInfo(var DrawInfo: TGridDrawInfo);
  1846.  
  1847.   procedure CalcFixedAxis(var Axis: TGridAxisDrawInfo; LineOptions: TGridOptions;
  1848.     FixedCount, FirstCell, CellCount: Integer; GetExtentFunc: TGetExtentsFunc);
  1849.   var
  1850.     I: Integer;
  1851.   begin
  1852.     with Axis do
  1853.     begin
  1854.       if LineOptions * Options = [] then
  1855.         EffectiveLineWidth := 0
  1856.       else
  1857.         EffectiveLineWidth := GridLineWidth;
  1858.  
  1859.       FixedBoundary := 0;
  1860.       for I := 0 to FixedCount - 1 do
  1861.         Inc(FixedBoundary, GetExtentFunc(I) + EffectiveLineWidth);
  1862.  
  1863.       FixedCellCount := FixedCount;
  1864.       FirstGridCell := FirstCell;
  1865.       GridCellCount := CellCount;
  1866.       GetExtent := GetExtentFunc;
  1867.     end;
  1868.   end;
  1869.  
  1870. begin
  1871.   CalcFixedAxis(DrawInfo.Horz, [goFixedVertLine, goVertLine], FixedCols,
  1872.     LeftCol, ColCount, GetColWidths);
  1873.   CalcFixedAxis(DrawInfo.Vert, [goFixedHorzLine, goHorzLine], FixedRows,
  1874.     TopRow, RowCount, GetRowHeights);
  1875. end;
  1876.  
  1877. { Calculates the TopLeft that will put the given Coord in view }
  1878. function TCustomGrid.CalcMaxTopLeft(const Coord: TGridCoord;
  1879.   const DrawInfo: TGridDrawInfo): TGridCoord;
  1880.  
  1881.   function CalcMaxCell(const Axis: TGridAxisDrawInfo; Start: Integer): Integer;
  1882.   var
  1883.     Line: Integer;
  1884.     I: Longint;
  1885.   begin
  1886.     Result := Start;
  1887.     with Axis do
  1888.     begin
  1889.       Line := GridExtent + EffectiveLineWidth;
  1890.       for I := Start downto FixedCellCount do
  1891.       begin
  1892.         Dec(Line, GetExtent(I));
  1893.         Dec(Line, EffectiveLineWidth);
  1894.         if Line < FixedBoundary then Break;
  1895.         Result := I;
  1896.       end;
  1897.     end;
  1898.   end;
  1899.  
  1900. begin
  1901.   Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
  1902.   Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
  1903. end;
  1904.  
  1905. procedure TCustomGrid.CalcSizingState(X, Y: Integer; var State: TGridState;
  1906.   var Index: Longint; var SizingPos, SizingOfs: Integer;
  1907.   var FixedInfo: TGridDrawInfo);
  1908.  
  1909.   procedure CalcAxisState(const AxisInfo: TGridAxisDrawInfo; Pos: Integer;
  1910.     NewState: TGridState);
  1911.   var
  1912.     I, Line, Back, Range: Integer;
  1913.   begin
  1914.     with AxisInfo do
  1915.     begin
  1916.       Line := FixedBoundary;
  1917.       Range := EffectiveLineWidth;
  1918.       Back := 0;
  1919.       if Range < 7 then
  1920.       begin
  1921.         Range := 7;
  1922.         Back := (Range - EffectiveLineWidth) shr 1;
  1923.       end;
  1924.       for I := FirstGridCell to GridCellCount - 1 do
  1925.       begin
  1926.         Inc(Line, GetExtent(I));
  1927.         if Line > GridExtent then Break;
  1928.         if (Pos >= Line - Back) and (Pos <= Line - Back + Range) then
  1929.         begin
  1930.           State := NewState;
  1931.           SizingPos := Line;
  1932.           SizingOfs := Line - Pos;
  1933.           Index := I;
  1934.           Exit;
  1935.         end;
  1936.         Inc(Line, EffectiveLineWidth);
  1937.       end;
  1938.       if (Pos >= GridExtent - Back) and (Pos <= GridExtent) then
  1939.       begin
  1940.         State := NewState;
  1941.         SizingPos := GridExtent;
  1942.         SizingOfs := GridExtent - Pos;
  1943.         Index := I;
  1944.       end;
  1945.     end;
  1946.   end;
  1947.  
  1948. var
  1949.   EffectiveOptions: TGridOptions;
  1950. begin
  1951.   State := gsNormal;
  1952.   Index := -1;
  1953.   EffectiveOptions := Options;
  1954.   if csDesigning in ComponentState then
  1955.     EffectiveOptions := EffectiveOptions + DesignOptionsBoost;
  1956.   if [goColSizing, goRowSizing] * EffectiveOptions <> [] then
  1957.     with FixedInfo do
  1958.     begin
  1959.       Vert.GridExtent := ClientHeight;
  1960.       Horz.GridExtent := ClientWidth;
  1961.       if (X > Horz.FixedBoundary) and (goColSizing in EffectiveOptions) then
  1962.       begin
  1963.         if Y >= Vert.FixedBoundary then Exit;
  1964.         CalcAxisState(Horz, X, gsColSizing);
  1965.       end
  1966.       else if (Y > Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then
  1967.       begin
  1968.         if X >= Horz.FixedBoundary then Exit;
  1969.         CalcAxisState(Vert, Y, gsRowSizing);
  1970.       end;
  1971.     end;
  1972. end;
  1973.  
  1974. procedure TCustomGrid.ChangeSize(NewColCount, NewRowCount: Longint);
  1975. var
  1976.   OldColCount, OldRowCount: Longint;
  1977.   OldDrawInfo: TGridDrawInfo;
  1978.  
  1979.   procedure MinRedraw(const OldInfo, NewInfo: TGridAxisDrawInfo; Axis: Integer);
  1980.   var
  1981.     R: TRect;
  1982.     First: Integer;
  1983.   begin
  1984.     if (OldInfo.LastFullVisibleCell = NewInfo.LastFullVisibleCell) then Exit;
  1985.     First := IMin(OldInfo.LastFullVisibleCell, NewInfo.LastFullVisibleCell);
  1986.     // Get the rectangle around the leftmost or topmost cell in the target range.
  1987.     R := CellRect(First and not Axis, First and Axis);
  1988.     R.Bottom := Height;
  1989.     R.Right := Width;
  1990.     Windows.InvalidateRect(Handle, @R, False);
  1991.   end;
  1992.  
  1993.   procedure DoChange;
  1994.   var
  1995.     Coord: TGridCoord;
  1996.     NewDrawInfo: TGridDrawInfo;
  1997.   begin
  1998.     if FColWidths <> nil then
  1999.     begin
  2000.       UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  2001.       UpdateExtents(FTabStops, ColCount, Integer(True));
  2002.     end;
  2003.     if FRowHeights <> nil then
  2004.       UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  2005.     Coord := FCurrent;
  2006.     if Row >= RowCount then Coord.Y := RowCount - 1;
  2007.     if Col >= ColCount then Coord.X := ColCount - 1;
  2008.     if (FCurrent.X <> Coord.X) or (FCurrent.Y <> Coord.Y) then
  2009.       MoveCurrent(Coord.X, Coord.Y, True, True);
  2010.     if (FAnchor.X <> Coord.X) or (FAnchor.Y <> Coord.Y) then
  2011.       MoveAnchor(Coord);
  2012.     if (LeftCol <> OldDrawInfo.Horz.FirstGridCell) or
  2013.       (TopRow <> OldDrawInfo.Vert.FirstGridCell) then
  2014.       InvalidateGrid
  2015.     else if HandleAllocated then
  2016.     begin
  2017.       CalcDrawInfo(NewDrawInfo);
  2018.       MinRedraw(OldDrawInfo.Horz, NewDrawInfo.Horz, 0);
  2019.       MinRedraw(OldDrawInfo.Vert, NewDrawInfo.Vert, -1);
  2020.     end;
  2021.     UpdateScrollRange;
  2022.     SizeChanged(OldColCount, OldRowCount);
  2023.   end;
  2024.  
  2025. begin
  2026.   if HandleAllocated then
  2027.     CalcDrawInfo(OldDrawInfo);
  2028.   OldColCount := FColCount;
  2029.   OldRowCount := FRowCount;
  2030.   FColCount := NewColCount;
  2031.   FRowCount := NewRowCount;
  2032.   if FixedCols > NewColCount then FFixedCols := NewColCount - 1;
  2033.   if FixedRows > NewRowCount then FFixedRows := NewRowCount - 1;
  2034.   try
  2035.     DoChange;
  2036.   except
  2037.     { Could not change size so try to clean up by setting the size back }
  2038.     FColCount := OldColCount;
  2039.     FRowCount := OldRowCount;
  2040.     DoChange;
  2041.     InvalidateGrid;
  2042.     raise;
  2043.   end;
  2044. end;
  2045.  
  2046. { Will move TopLeft so that Coord is in view }
  2047. procedure TCustomGrid.ClampInView(const Coord: TGridCoord);
  2048. var
  2049.   DrawInfo: TGridDrawInfo;
  2050.   MaxTopLeft: TGridCoord;
  2051.   OldTopLeft: TGridCoord;
  2052. begin
  2053.   if not HandleAllocated then Exit;
  2054.   CalcDrawInfo(DrawInfo);
  2055.   with DrawInfo, Coord do
  2056.   begin
  2057.     if (X > Horz.LastFullVisibleCell) or
  2058.       (Y > Vert.LastFullVisibleCell) or (X < LeftCol) or (Y < TopRow) then
  2059.     begin
  2060.       OldTopLeft := FTopLeft;
  2061.       MaxTopLeft := CalcMaxTopLeft(Coord, DrawInfo);
  2062.       Update;
  2063.       if X < LeftCol then FTopLeft.X := X
  2064.       else if X > Horz.LastFullVisibleCell then FTopLeft.X := MaxTopLeft.X;
  2065.       if Y < TopRow then FTopLeft.Y := Y
  2066.       else if Y > Vert.LastFullVisibleCell then FTopLeft.Y := MaxTopLeft.Y;
  2067.       TopLeftMoved(OldTopLeft);
  2068.     end;
  2069.   end;
  2070. end;
  2071.  
  2072. procedure TCustomGrid.DrawSizingLine(const DrawInfo: TGridDrawInfo);
  2073. var
  2074.   OldPen: TPen;
  2075. begin
  2076.   OldPen := TPen.Create;
  2077.   try
  2078.     with Canvas, DrawInfo do
  2079.     begin
  2080.       OldPen.Assign(Pen);
  2081.       Pen.Style := psDot;
  2082.       Pen.Mode := pmXor;
  2083.       Pen.Width := 1;
  2084.       try
  2085.         if FGridState = gsRowSizing then
  2086.         begin
  2087.           MoveTo(0, FSizingPos);
  2088.           LineTo(Horz.GridBoundary, FSizingPos);
  2089.         end
  2090.         else
  2091.         begin
  2092.           MoveTo(FSizingPos, 0);
  2093.           LineTo(FSizingPos, Vert.GridBoundary);
  2094.         end;
  2095.       finally
  2096.         Pen := OldPen;
  2097.       end;
  2098.     end;
  2099.   finally
  2100.     OldPen.Free;
  2101.   end;
  2102. end;
  2103.  
  2104. procedure TCustomGrid.DrawMove;
  2105. var
  2106.   OldPen: TPen;
  2107.   Pos: Integer;
  2108.   R: TRect;
  2109. begin
  2110.   OldPen := TPen.Create;
  2111.   try
  2112.     with Canvas do
  2113.     begin
  2114.       OldPen.Assign(Pen);
  2115.       try
  2116.         Pen.Style := psDot;
  2117.         Pen.Mode := pmXor;
  2118.         Pen.Width := 5;
  2119.         if FGridState = gsRowMoving then
  2120.         begin
  2121.           R := CellRect(0, FMovePos);
  2122.           if FMovePos > FMoveIndex then
  2123.             Pos := R.Bottom else
  2124.             Pos := R.Top;
  2125.           MoveTo(0, Pos);
  2126.           LineTo(ClientWidth, Pos);
  2127.         end
  2128.         else
  2129.         begin
  2130.           R := CellRect(FMovePos, 0);
  2131.           if FMovePos > FMoveIndex then
  2132.             Pos := R.Right else
  2133.             Pos := R.Left;
  2134.           MoveTo(Pos, 0);
  2135.           LineTo(Pos, ClientHeight);
  2136.         end;
  2137.       finally
  2138.         Canvas.Pen := OldPen;
  2139.       end;
  2140.     end;
  2141.   finally
  2142.     OldPen.Free;
  2143.   end;
  2144. end;
  2145.  
  2146. procedure TCustomGrid.FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  2147. begin
  2148.   MoveCurrent(ACol, ARow, MoveAnchor, True);
  2149.   UpdateEdit;
  2150.   Click;
  2151. end;
  2152.  
  2153. procedure TCustomGrid.GridRectToScreenRect(GridRect: TGridRect;
  2154.   var ScreenRect: TRect; IncludeLine: Boolean);
  2155.  
  2156.   function LinePos(const AxisInfo: TGridAxisDrawInfo; Line: Integer): Integer;
  2157.   var
  2158.     Start, I: Longint;
  2159.   begin
  2160.     with AxisInfo do
  2161.     begin
  2162.       Result := 0;
  2163.       if Line < FixedCellCount then
  2164.         Start := 0
  2165.       else
  2166.       begin
  2167.         if Line >= FirstGridCell then
  2168.           Result := FixedBoundary;
  2169.         Start := FirstGridCell;
  2170.       end;
  2171.       for I := Start to Line - 1 do
  2172.       begin
  2173.         Inc(Result, GetExtent(I) + EffectiveLineWidth);
  2174.         if Result > GridExtent then
  2175.         begin
  2176.           Result := 0;
  2177.           Exit;
  2178.         end;
  2179.       end;
  2180.     end;
  2181.   end;
  2182.  
  2183.   function CalcAxis(const AxisInfo: TGridAxisDrawInfo;
  2184.     GridRectMin, GridRectMax: Integer;
  2185.     var ScreenRectMin, ScreenRectMax: Integer): Boolean;
  2186.   begin
  2187.     Result := False;
  2188.     with AxisInfo do
  2189.     begin
  2190.       if (GridRectMin >= FixedCellCount) and (GridRectMin < FirstGridCell) then
  2191.         if GridRectMax < FirstGridCell then
  2192.         begin
  2193.           FillChar(ScreenRect, SizeOf(ScreenRect), 0); { erase partial results }
  2194.           Exit;
  2195.         end
  2196.         else
  2197.           GridRectMin := FirstGridCell;
  2198.       if GridRectMax > LastFullVisibleCell then
  2199.       begin
  2200.         GridRectMax := LastFullVisibleCell;
  2201.         if GridRectMax < GridCellCount - 1 then Inc(GridRectMax);
  2202.         if LinePos(AxisInfo, GridRectMax) = 0 then
  2203.           Dec(GridRectMax);
  2204.       end;
  2205.  
  2206.       ScreenRectMin := LinePos(AxisInfo, GridRectMin);
  2207.       ScreenRectMax := LinePos(AxisInfo, GridRectMax);
  2208.       if ScreenRectMax = 0 then
  2209.         ScreenRectMax := ScreenRectMin + GetExtent(GridRectMin)
  2210.       else
  2211.         Inc(ScreenRectMax, GetExtent(GridRectMax));
  2212.       if ScreenRectMax > GridExtent then
  2213.         ScreenRectMax := GridExtent;
  2214.       if IncludeLine then Inc(ScreenRectMax, EffectiveLineWidth);
  2215.     end;
  2216.     Result := True;
  2217.   end;
  2218.  
  2219. var
  2220.   DrawInfo: TGridDrawInfo;
  2221. begin
  2222.   FillChar(ScreenRect, SizeOf(ScreenRect), 0);
  2223.   if (GridRect.Left > GridRect.Right) or (GridRect.Top > GridRect.Bottom) then
  2224.     Exit;
  2225.   CalcDrawInfo(DrawInfo);
  2226.   with DrawInfo do
  2227.   begin
  2228.     if GridRect.Left > Horz.LastFullVisibleCell + 1 then Exit;
  2229.     if GridRect.Top > Vert.LastFullVisibleCell + 1 then Exit;
  2230.  
  2231.     if CalcAxis(Horz, GridRect.Left, GridRect.Right, ScreenRect.Left,
  2232.       ScreenRect.Right) then
  2233.     begin
  2234.       CalcAxis(Vert, GridRect.Top, GridRect.Bottom, ScreenRect.Top,
  2235.         ScreenRect.Bottom);
  2236.     end;
  2237.   end;
  2238. end;
  2239.  
  2240. procedure TCustomGrid.Initialize;
  2241. begin
  2242.   FTopLeft.X := FixedCols;
  2243.   FTopLeft.Y := FixedRows;
  2244.   FCurrent := FTopLeft;
  2245.   FAnchor := FCurrent;
  2246.   if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2247. end;
  2248.  
  2249. procedure TCustomGrid.InvalidateCell(ACol, ARow: Longint);
  2250. var
  2251.   Rect: TGridRect;
  2252. begin
  2253.   Rect.Top := ARow;
  2254.   Rect.Left := ACol;
  2255.   Rect.Bottom := ARow;
  2256.   Rect.Right := ACol;
  2257.   InvalidateRect(Rect);
  2258. end;
  2259.  
  2260. procedure TCustomGrid.InvalidateCol(ACol: Longint);
  2261. var
  2262.   Rect: TGridRect;
  2263. begin
  2264.   if not HandleAllocated then Exit;
  2265.   Rect.Top := 0;
  2266.   Rect.Left := ACol;
  2267.   Rect.Bottom := VisibleRowCount+1;
  2268.   Rect.Right := ACol;
  2269.   InvalidateRect(Rect);
  2270. end;
  2271.  
  2272. procedure TCustomGrid.InvalidateRow(ARow: Longint);
  2273. var
  2274.   Rect: TGridRect;
  2275. begin
  2276.   if not HandleAllocated then Exit;
  2277.   Rect.Top := ARow;
  2278.   Rect.Left := 0;
  2279.   Rect.Bottom := ARow;
  2280.   Rect.Right := VisibleColCount+1;
  2281.   InvalidateRect(Rect);
  2282. end;
  2283.  
  2284. procedure TCustomGrid.InvalidateGrid;
  2285. begin
  2286.   Invalidate;
  2287. end;
  2288.  
  2289. procedure TCustomGrid.InvalidateRect(ARect: TGridRect);
  2290. var
  2291.   InvalidRect: TRect;
  2292. begin
  2293.   if not HandleAllocated then Exit;
  2294.   GridRectToScreenRect(ARect, InvalidRect, True);
  2295.   Windows.InvalidateRect(Handle, @InvalidRect, False);
  2296. end;
  2297.  
  2298. procedure TCustomGrid.ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  2299. var
  2300.   NewTopLeft, MaxTopLeft: TGridCoord;
  2301.   DrawInfo: TGridDrawInfo;
  2302.  
  2303.   function Min: Longint;
  2304.   begin
  2305.     if ScrollBar = SB_HORZ then Result := FixedCols
  2306.     else Result := FixedRows;
  2307.   end;
  2308.  
  2309.   function Max: Longint;
  2310.   begin
  2311.     if ScrollBar = SB_HORZ then Result := MaxTopLeft.X
  2312.     else Result := MaxTopLeft.Y;
  2313.   end;
  2314.  
  2315.   function PageUp: Longint;
  2316.   var
  2317.     MaxTopLeft: TGridCoord;
  2318.   begin
  2319.     MaxTopLeft := CalcMaxTopLeft(FTopLeft, DrawInfo);
  2320.     if ScrollBar = SB_HORZ then
  2321.       Result := FTopLeft.X - MaxTopLeft.X else
  2322.       Result := FTopLeft.Y - MaxTopLeft.Y;
  2323.     if Result < 1 then Result := 1;
  2324.   end;
  2325.  
  2326.   function PageDown: Longint;
  2327.   var
  2328.     DrawInfo: TGridDrawInfo;
  2329.   begin
  2330.     CalcDrawInfo(DrawInfo);
  2331.     with DrawInfo do
  2332.       if ScrollBar = SB_HORZ then
  2333.         Result := Horz.LastFullVisibleCell - FTopLeft.X else
  2334.         Result := Vert.LastFullVisibleCell - FTopLeft.Y;
  2335.     if Result < 1 then Result := 1;
  2336.   end;
  2337.  
  2338.   function CalcScrollBar(Value: Longint): Longint;
  2339.   begin
  2340.     Result := Value;
  2341.     case ScrollCode of
  2342.       SB_LINEUP:
  2343.         Result := Value - 1;
  2344.       SB_LINEDOWN:
  2345.         Result := Value + 1;
  2346.       SB_PAGEUP:
  2347.         Result := Value - PageUp;
  2348.       SB_PAGEDOWN:
  2349.         Result := Value + PageDown;
  2350.       SB_THUMBPOSITION, SB_THUMBTRACK:
  2351.         if (goThumbTracking in Options) or (ScrollCode = SB_THUMBPOSITION) then
  2352.           Result := Min + LongMulDiv(Pos, Max - Min, MaxShortInt);
  2353.       SB_BOTTOM:
  2354.         Result := Min;
  2355.       SB_TOP:
  2356.         Result := Min;
  2357.     end;
  2358.   end;
  2359.  
  2360.   procedure ModifyPixelScrollBar(Code, Pos: Cardinal);
  2361.   var
  2362.     NewOffset: Integer;
  2363.     OldOffset: Integer;
  2364.     R: TGridRect;
  2365.   begin
  2366.     NewOffset := FColOffset;
  2367.     case Code of
  2368.       SB_LINEUP: Dec(NewOffset, Canvas.TextWidth('0'));
  2369.       SB_LINEDOWN: Inc(NewOffset, Canvas.TextWidth('0'));
  2370.       SB_PAGEUP: Dec(NewOffset, ClientWidth);
  2371.       SB_PAGEDOWN: Inc(NewOffset, ClientWidth);
  2372.       SB_THUMBPOSITION: NewOffset := Pos;
  2373.       SB_THUMBTRACK: if goThumbTracking in Options then NewOffset := Pos;
  2374.       SB_BOTTOM: NewOffset := 0;
  2375.       SB_TOP: NewOffset := ColWidths[0] - ClientWidth;
  2376.     end;
  2377.     if NewOffset < 0 then
  2378.       NewOffset := 0
  2379.     else if NewOffset >= ColWidths[0] - ClientWidth then
  2380.       NewOffset := ColWidths[0] - ClientWidth;
  2381.     if NewOffset <> FColOffset then
  2382.     begin
  2383.       OldOffset := FColOffset;
  2384.       FColOffset := NewOffset;
  2385.       ScrollData(OldOffset - NewOffset, 0);
  2386.       FillChar(R, SizeOf(R), 0);
  2387.       R.Bottom := FixedRows;
  2388.       InvalidateRect(R);
  2389.       Update;
  2390.       UpdateScrollPos;
  2391.     end;
  2392.   end;
  2393.  
  2394. begin
  2395.   if Visible and CanFocus and TabStop and not (csDesigning in ComponentState) then
  2396.     SetFocus;
  2397.   if (ScrollBar = SB_HORZ) and (ColCount = 1) then
  2398.   begin
  2399.     ModifyPixelScrollBar(ScrollCode, Pos);
  2400.     Exit;
  2401.   end;
  2402.   CalcDrawInfo(DrawInfo);
  2403.   MaxTopLeft.X := ColCount - 1;
  2404.   MaxTopLeft.Y := RowCount - 1;
  2405.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2406.   NewTopLeft := FTopLeft;
  2407.   if ScrollBar = SB_HORZ then NewTopLeft.X := CalcScrollBar(NewTopLeft.X)
  2408.   else NewTopLeft.Y := CalcScrollBar(NewTopLeft.Y);
  2409.   if NewTopLeft.X < FixedCols then NewTopLeft.X := FixedCols
  2410.   else if NewTopLeft.X > MaxTopLeft.X then NewTopLeft.X := MaxTopLeft.X;
  2411.   if NewTopLeft.Y < FixedRows then NewTopLeft.Y := FixedRows
  2412.   else if NewTopLeft.Y > MaxTopLeft.Y then NewTopLeft.Y := MaxTopLeft.Y;
  2413.   if (NewTopLeft.X <> FTopLeft.X) or (NewTopLeft.Y <> FTopLeft.Y) then
  2414.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  2415. end;
  2416.  
  2417. procedure TCustomGrid.MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  2418. var
  2419.   Min, Max: Longint;
  2420. begin
  2421.   if CellPos = FromIndex then CellPos := ToIndex
  2422.   else
  2423.   begin
  2424.     Min := FromIndex;
  2425.     Max := ToIndex;
  2426.     if FromIndex > ToIndex then
  2427.     begin
  2428.       Min := ToIndex;
  2429.       Max := FromIndex;
  2430.     end;
  2431.     if (CellPos >= Min) and (CellPos <= Max) then
  2432.       if FromIndex > ToIndex then
  2433.         Inc(CellPos) else
  2434.         Dec(CellPos);
  2435.   end;
  2436. end;
  2437.  
  2438. procedure TCustomGrid.MoveAnchor(const NewAnchor: TGridCoord);
  2439. var
  2440.   OldSel: TGridRect;
  2441. begin
  2442.   if [goRangeSelect, goEditing] * Options = [goRangeSelect] then
  2443.   begin
  2444.     OldSel := Selection;
  2445.     FAnchor := NewAnchor;
  2446.     if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2447.     ClampInView(NewAnchor);
  2448.     SelectionMoved(OldSel);
  2449.   end
  2450.   else MoveCurrent(NewAnchor.X, NewAnchor.Y, True, True);
  2451. end;
  2452.  
  2453. procedure TCustomGrid.MoveCurrent(ACol, ARow: Longint; MoveAnchor,
  2454.   Show: Boolean);
  2455. var
  2456.   OldSel: TGridRect;
  2457.   OldCurrent: TGridCoord;
  2458. begin
  2459.   if (ACol < 0) or (ARow < 0) or (ACol >= ColCount) or (ARow >= RowCount) then
  2460.     InvalidOp(SIndexOutOfRange);
  2461.   if SelectCell(ACol, ARow) then
  2462.   begin
  2463.     OldSel := Selection;
  2464.     OldCurrent := FCurrent;
  2465.     FCurrent.X := ACol;
  2466.     FCurrent.Y := ARow;
  2467.     if not (goAlwaysShowEditor in Options) then HideEditor;
  2468.     if MoveAnchor or not (goRangeSelect in Options) then
  2469.     begin
  2470.       FAnchor := FCurrent;
  2471.       if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2472.     end;
  2473.     if goRowSelect in Options then FCurrent.X := FixedCols;
  2474.     if Show then ClampInView(FCurrent);
  2475.     SelectionMoved(OldSel);
  2476.     with OldCurrent do InvalidateCell(X, Y);
  2477.     with FCurrent do InvalidateCell(ACol, ARow);
  2478.   end;
  2479. end;
  2480.  
  2481. procedure TCustomGrid.MoveTopLeft(ALeft, ATop: Longint);
  2482. var
  2483.   OldTopLeft: TGridCoord;
  2484. begin
  2485.   if (ALeft = FTopLeft.X) and (ATop = FTopLeft.Y) then Exit;
  2486.   Update;
  2487.   OldTopLeft := FTopLeft;
  2488.   FTopLeft.X := ALeft;
  2489.   FTopLeft.Y := ATop;
  2490.   TopLeftMoved(OldTopLeft);
  2491. end;
  2492.  
  2493. procedure TCustomGrid.ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  2494. begin
  2495.   InvalidateGrid;
  2496. end;
  2497.  
  2498. procedure TCustomGrid.ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  2499. begin
  2500.   InvalidateGrid;
  2501. end;
  2502.  
  2503. procedure TCustomGrid.SelectionMoved(const OldSel: TGridRect);
  2504. var
  2505.   OldRect, NewRect: TRect;
  2506.   AXorRects: TXorRects;
  2507.   I: Integer;
  2508. begin
  2509.   if not HandleAllocated then Exit;
  2510.   GridRectToScreenRect(OldSel, OldRect, True);
  2511.   GridRectToScreenRect(Selection, NewRect, True);
  2512.   XorRects(OldRect, NewRect, AXorRects);
  2513.   for I := Low(AXorRects) to High(AXorRects) do
  2514.     Windows.InvalidateRect(Handle, @AXorRects[I], False);
  2515. end;
  2516.  
  2517. procedure TCustomGrid.ScrollDataInfo(DX, DY: Integer;
  2518.   var DrawInfo: TGridDrawInfo);
  2519. var
  2520.   ScrollArea: TRect;
  2521.   ScrollFlags: Integer;
  2522. begin
  2523.   with DrawInfo do
  2524.   begin
  2525.     ScrollFlags := SW_INVALIDATE;
  2526.     if not DefaultDrawing then
  2527.       ScrollFlags := ScrollFlags or SW_ERASE;
  2528.     { Scroll the area }
  2529.     if DY = 0 then
  2530.     begin
  2531.       { Scroll both the column titles and data area at the same time }
  2532.       ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.GridExtent);
  2533.       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2534.     end
  2535.     else if DX = 0 then
  2536.     begin
  2537.       { Scroll both the row titles and data area at the same time }
  2538.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.GridExtent, Vert.GridExtent);
  2539.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2540.     end
  2541.     else
  2542.     begin
  2543.       { Scroll titles and data area separately }
  2544.       { Column titles }
  2545.       ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.FixedBoundary);
  2546.       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2547.       { Row titles }
  2548.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.FixedBoundary, Vert.GridExtent);
  2549.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2550.       { Data area }
  2551.       ScrollArea := Rect(Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridExtent,
  2552.         Vert.GridExtent);
  2553.       ScrollWindowEx(Handle, DX, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2554.     end;
  2555.   end;
  2556. end;
  2557.  
  2558. procedure TCustomGrid.ScrollData(DX, DY: Integer);
  2559. var
  2560.   DrawInfo: TGridDrawInfo;
  2561. begin
  2562.   CalcDrawInfo(DrawInfo);
  2563.   ScrollDataInfo(DX, DY, DrawInfo);
  2564. end;
  2565.  
  2566. procedure TCustomGrid.TopLeftMoved(const OldTopLeft: TGridCoord);
  2567.  
  2568.   function CalcScroll(const AxisInfo: TGridAxisDrawInfo;
  2569.     OldPos, CurrentPos: Integer; var Amount: Longint): Boolean;
  2570.   var
  2571.     Start, Stop: Longint;
  2572.     I: Longint;
  2573.   begin
  2574.     Result := False;
  2575.     with AxisInfo do
  2576.     begin
  2577.       if OldPos < CurrentPos then
  2578.       begin
  2579.         Start := OldPos;
  2580.         Stop := CurrentPos;
  2581.       end
  2582.       else
  2583.       begin
  2584.         Start := CurrentPos;
  2585.         Stop := OldPos;
  2586.       end;
  2587.       Amount := 0;
  2588.       for I := Start to Stop - 1 do
  2589.       begin
  2590.         Inc(Amount, GetExtent(I) + EffectiveLineWidth);
  2591.         if Amount > (GridBoundary - FixedBoundary) then
  2592.         begin
  2593.           { Scroll amount too big, redraw the whole thing }
  2594.           InvalidateGrid;
  2595.           Exit;
  2596.         end;
  2597.       end;
  2598.       if OldPos < CurrentPos then Amount := -Amount;
  2599.     end;
  2600.     Result := True;
  2601.   end;
  2602.  
  2603. var
  2604.   DrawInfo: TGridDrawInfo;
  2605.   Delta: TGridCoord;
  2606. begin
  2607.   UpdateScrollPos;
  2608.   CalcDrawInfo(DrawInfo);
  2609.   if CalcScroll(DrawInfo.Horz, OldTopLeft.X, FTopLeft.X, Delta.X) and
  2610.     CalcScroll(DrawInfo.Vert, OldTopLeft.Y, FTopLeft.Y, Delta.Y) then
  2611.     ScrollDataInfo(Delta.X, Delta.Y, DrawInfo);
  2612.   TopLeftChanged;
  2613. end;
  2614.  
  2615. procedure TCustomGrid.UpdateScrollPos;
  2616. var
  2617.   DrawInfo: TGridDrawInfo;
  2618.   MaxTopLeft: TGridCoord;
  2619.  
  2620.   procedure SetScroll(Code: Word; Value: Integer);
  2621.   begin
  2622.     if GetScrollPos(Handle, Code) <> Value then
  2623.       SetScrollPos(Handle, Code, Value, True);
  2624.   end;
  2625.  
  2626. begin
  2627.   if (not HandleAllocated) or (ScrollBars = ssNone) then Exit;
  2628.   CalcDrawInfo(DrawInfo);
  2629.   MaxTopLeft.X := ColCount - 1;
  2630.   MaxTopLeft.Y := RowCount - 1;
  2631.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2632.   if ScrollBars in [ssHorizontal, ssBoth] then
  2633.     if ColCount = 1 then
  2634.     begin
  2635.       if (FColOffset > 0) and (ClientWidth > ColWidths[0] - FColOffset) then
  2636.         ModifyScrollbar(SB_HORZ, SB_THUMBPOSITION, ColWidths[0] - ClientWidth)
  2637.       else
  2638.         SetScroll(SB_HORZ, FColOffset)
  2639.     end
  2640.     else
  2641.       SetScroll(SB_HORZ, LongMulDiv(FTopLeft.X - FixedCols, MaxShortInt,
  2642.         MaxTopLeft.X - FixedCols));
  2643.   if ScrollBars in [ssVertical, ssBoth] then
  2644.     SetScroll(SB_VERT, LongMulDiv(FTopLeft.Y - FixedRows, MaxShortInt,
  2645.       MaxTopLeft.Y - FixedRows));
  2646. end;
  2647.  
  2648. procedure TCustomGrid.UpdateScrollRange;
  2649. var
  2650.   MaxTopLeft, OldTopLeft: TGridCoord;
  2651.   DrawInfo: TGridDrawInfo;
  2652.   OldScrollBars: TScrollStyle;
  2653.   Updated: Boolean;
  2654.  
  2655.   procedure DoUpdate;
  2656.   begin
  2657.     if not Updated then
  2658.     begin
  2659.       Update;
  2660.       Updated := True;
  2661.     end;
  2662.   end;
  2663.  
  2664.   function ScrollBarVisible(Code: Word): Boolean;
  2665.   var
  2666.     Min, Max: Integer;
  2667.   begin
  2668.     Result := False;
  2669.     if (ScrollBars = ssBoth) or
  2670.       ((Code = SB_HORZ) and (ScrollBars = ssHorizontal)) or
  2671.       ((Code = SB_VERT) and (ScrollBars = ssVertical)) then
  2672.     begin
  2673.       GetScrollRange(Handle, Code, Min, Max);
  2674.       Result := Min <> Max;
  2675.     end;
  2676.   end;
  2677.  
  2678.   procedure CalcSizeInfo;
  2679.   begin
  2680.     CalcDrawInfoXY(DrawInfo, DrawInfo.Horz.GridExtent, DrawInfo.Vert.GridExtent);
  2681.     MaxTopLeft.X := ColCount - 1;
  2682.     MaxTopLeft.Y := RowCount - 1;
  2683.     MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2684.   end;
  2685.  
  2686.   procedure SetAxisRange(var Max, Old, Current: Longint; Code: Word;
  2687.     Fixeds: Integer);
  2688.   begin
  2689.     CalcSizeInfo;
  2690.     if Fixeds < Max then
  2691.       SetScrollRange(Handle, Code, 0, MaxShortInt, True)
  2692.     else
  2693.       SetScrollRange(Handle, Code, 0, 0, True);
  2694.     if Old > Max then
  2695.     begin
  2696.       DoUpdate;
  2697.       Current := Max;
  2698.     end;
  2699.   end;
  2700.  
  2701.   procedure SetHorzRange;
  2702.   var
  2703.     Range: Integer;
  2704.   begin
  2705.     if OldScrollBars in [ssHorizontal, ssBoth] then
  2706.       if ColCount = 1 then
  2707.       begin
  2708.         Range := ColWidths[0] - ClientWidth;
  2709.         if Range < 0 then Range := 0;
  2710.         SetScrollRange(Handle, SB_HORZ, 0, Range, True);
  2711.       end
  2712.       else
  2713.         SetAxisRange(MaxTopLeft.X, OldTopLeft.X, FTopLeft.X, SB_HORZ, FixedCols);
  2714.   end;
  2715.  
  2716.   procedure SetVertRange;
  2717.   begin
  2718.     if OldScrollBars in [ssVertical, ssBoth] then
  2719.       SetAxisRange(MaxTopLeft.Y, OldTopLeft.Y, FTopLeft.Y, SB_VERT, FixedRows);
  2720.   end;
  2721.  
  2722. begin
  2723.   if (ScrollBars = ssNone) or not HandleAllocated then Exit;
  2724.   with DrawInfo do
  2725.   begin
  2726.     Horz.GridExtent := ClientWidth;
  2727.     Vert.GridExtent := ClientHeight;
  2728.     { Ignore scroll bars for initial calculation }
  2729.     if ScrollBarVisible(SB_HORZ) then
  2730.       Inc(Vert.GridExtent, GetSystemMetrics(SM_CYHSCROLL));
  2731.     if ScrollBarVisible(SB_VERT) then
  2732.       Inc(Horz.GridExtent, GetSystemMetrics(SM_CXVSCROLL));
  2733.   end;
  2734.   OldTopLeft := FTopLeft;
  2735.   { Temporarily mark us as not having scroll bars to avoid recursion }
  2736.   OldScrollBars := FScrollBars;
  2737.   FScrollBars := ssNone;
  2738.   Updated := False;
  2739.   try
  2740.     { Update scrollbars }
  2741.     SetHorzRange;
  2742.     DrawInfo.Vert.GridExtent := ClientHeight;
  2743.     SetVertRange;
  2744.     if DrawInfo.Horz.GridExtent <> ClientWidth then
  2745.     begin
  2746.       DrawInfo.Horz.GridExtent := ClientWidth;
  2747.       SetHorzRange;
  2748.     end;
  2749.   finally
  2750.     FScrollBars := OldScrollBars;
  2751.   end;
  2752.   UpdateScrollPos;
  2753.   if (FTopLeft.X <> OldTopLeft.X) or (FTopLeft.Y <> OldTopLeft.Y) then
  2754.     TopLeftMoved(OldTopLeft);
  2755. end;
  2756.  
  2757. function TCustomGrid.CreateEditor: TInplaceEdit;
  2758. begin
  2759.   Result := TInplaceEdit.Create(Self);
  2760. end;
  2761.  
  2762. procedure TCustomGrid.CreateParams(var Params: TCreateParams);
  2763. begin
  2764.   inherited CreateParams(Params);
  2765.   with Params do
  2766.   begin
  2767.     Style := Style or WS_TABSTOP;
  2768.     if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL;
  2769.     if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
  2770.     WindowClass.style := CS_DBLCLKS;
  2771.     if FBorderStyle = bsSingle then
  2772.       if NewStyleControls and Ctl3D then
  2773.       begin
  2774.         Style := Style and not WS_BORDER;
  2775.         ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  2776.       end
  2777.       else
  2778.         Style := Style or WS_BORDER;
  2779.   end;
  2780. end;
  2781.  
  2782. procedure TCustomGrid.KeyDown(var Key: Word; Shift: TShiftState);
  2783. var
  2784.   NewTopLeft, NewCurrent, MaxTopLeft: TGridCoord;
  2785.   DrawInfo: TGridDrawInfo;
  2786.   PageWidth, PageHeight: Integer;
  2787.  
  2788.   procedure CalcPageExtents;
  2789.   begin
  2790.     CalcDrawInfo(DrawInfo);
  2791.     PageWidth := DrawInfo.Horz.LastFullVisibleCell - LeftCol;
  2792.     if PageWidth < 1 then PageWidth := 1;
  2793.     PageHeight := DrawInfo.Vert.LastFullVisibleCell - TopRow;
  2794.     if PageHeight < 1 then PageHeight := 1;
  2795.   end;
  2796.  
  2797.   procedure Restrict(var Coord: TGridCoord; MinX, MinY, MaxX, MaxY: Longint);
  2798.   begin
  2799.     with Coord do
  2800.     begin
  2801.       if X > MaxX then X := MaxX
  2802.       else if X < MinX then X := MinX;
  2803.       if Y > MaxY then Y := MaxY
  2804.       else if Y < MinY then Y := MinY;
  2805.     end;
  2806.   end;
  2807.  
  2808. begin
  2809.   inherited KeyDown(Key, Shift);
  2810.   if not CanGridAcceptKey(Key, Shift) then Key := 0;
  2811.   NewCurrent := FCurrent;
  2812.   NewTopLeft := FTopLeft;
  2813.   CalcPageExtents;
  2814.   if ssCtrl in Shift then
  2815.     case Key of
  2816.       VK_UP: Dec(NewTopLeft.Y);
  2817.       VK_DOWN: Inc(NewTopLeft.Y);
  2818.       VK_LEFT:
  2819.         if not (goRowSelect in Options) then
  2820.         begin
  2821.           Dec(NewCurrent.X, PageWidth);
  2822.           Dec(NewTopLeft.X, PageWidth);
  2823.         end;
  2824.       VK_RIGHT:
  2825.         if not (goRowSelect in Options) then
  2826.         begin
  2827.           Inc(NewCurrent.X, PageWidth);
  2828.           Inc(NewTopLeft.X, PageWidth);
  2829.         end;
  2830.       VK_PRIOR: NewCurrent.Y := TopRow;
  2831.       VK_NEXT: NewCurrent.Y := DrawInfo.Vert.LastFullVisibleCell;
  2832.       VK_HOME:
  2833.         begin
  2834.           NewCurrent.X := FixedCols;
  2835.           NewCurrent.Y := FixedRows;
  2836.         end;
  2837.       VK_END:
  2838.         begin
  2839.           NewCurrent.X := ColCount - 1;
  2840.           NewCurrent.Y := RowCount - 1;
  2841.         end;
  2842.     end
  2843.   else
  2844.     case Key of
  2845.       VK_UP: Dec(NewCurrent.Y);
  2846.       VK_DOWN: Inc(NewCurrent.Y);
  2847.       VK_LEFT:
  2848.         if goRowSelect in Options then
  2849.           Dec(NewCurrent.Y) else
  2850.           Dec(NewCurrent.X);
  2851.       VK_RIGHT:
  2852.         if goRowSelect in Options then
  2853.           Inc(NewCurrent.Y) else
  2854.           Inc(NewCurrent.X);
  2855.       VK_NEXT:
  2856.         begin
  2857.           Inc(NewCurrent.Y, PageHeight);
  2858.           Inc(NewTopLeft.Y, PageHeight);
  2859.         end;
  2860.       VK_PRIOR:
  2861.         begin
  2862.           Dec(NewCurrent.Y, PageHeight);
  2863.           Dec(NewTopLeft.Y, PageHeight);
  2864.         end;
  2865.       VK_HOME:
  2866.         if goRowSelect in Options then
  2867.           NewCurrent.Y := FixedRows else
  2868.           NewCurrent.X := FixedCols;
  2869.       VK_END:
  2870.         if goRowSelect in Options then
  2871.           NewCurrent.Y := RowCount - 1 else
  2872.           NewCurrent.X := ColCount - 1;
  2873.       VK_TAB:
  2874.         if not (ssAlt in Shift) then
  2875.         repeat
  2876.           if ssShift in Shift then
  2877.           begin
  2878.             Dec(NewCurrent.X);
  2879.             if NewCurrent.X < FixedCols then
  2880.             begin
  2881.               NewCurrent.X := ColCount - 1;
  2882.               Dec(NewCurrent.Y);
  2883.               if NewCurrent.Y < FixedRows then NewCurrent.Y := RowCount - 1;
  2884.             end;
  2885.             Shift := [];
  2886.           end
  2887.           else
  2888.           begin
  2889.             Inc(NewCurrent.X);
  2890.             if NewCurrent.X >= ColCount then
  2891.             begin
  2892.               NewCurrent.X := FixedCols;
  2893.               Inc(NewCurrent.Y);
  2894.               if NewCurrent.Y >= RowCount then NewCurrent.Y := FixedRows;
  2895.             end;
  2896.           end;
  2897.         until TabStops[NewCurrent.X] or (NewCurrent.X = FCurrent.X);
  2898.       VK_F2: EditorMode := True;
  2899.     end;
  2900.   MaxTopLeft.X := ColCount - 1;
  2901.   MaxTopLeft.Y := RowCount - 1;
  2902.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2903.   Restrict(NewTopLeft, FixedCols, FixedRows, MaxTopLeft.X, MaxTopLeft.Y);
  2904.   if (NewTopLeft.X <> LeftCol) or (NewTopLeft.Y <> TopRow) then
  2905.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  2906.   Restrict(NewCurrent, FixedCols, FixedRows, ColCount - 1, RowCount - 1);
  2907.   if (NewCurrent.X <> Col) or (NewCurrent.Y <> Row) then
  2908.     FocusCell(NewCurrent.X, NewCurrent.Y, not (ssShift in Shift));
  2909. end;
  2910.  
  2911. procedure TCustomGrid.KeyPress(var Key: Char);
  2912. begin
  2913.   inherited KeyPress(Key);
  2914.   if not (goAlwaysShowEditor in Options) and (Key = #13) then
  2915.   begin
  2916.     if FEditorMode then
  2917.       HideEditor else
  2918.       ShowEditor;
  2919.     Key := #0;
  2920.   end;
  2921. end;
  2922.  
  2923. procedure TCustomGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2924.   X, Y: Integer);
  2925. var
  2926.   CellHit: TGridCoord;
  2927.   DrawInfo: TGridDrawInfo;
  2928.   MoveDrawn: Boolean;
  2929. begin
  2930.   MoveDrawn := False;
  2931.   HideEdit;
  2932.   if not (csDesigning in ComponentState) and CanFocus then
  2933.   begin
  2934.     SetFocus;
  2935.     if ValidParentForm(Self).ActiveControl <> Self then
  2936.     begin
  2937.       MouseCapture := False;
  2938.       Exit;
  2939.     end;
  2940.   end;
  2941.   if (Button = mbLeft) and (ssDouble in Shift) then
  2942.     DblClick
  2943.   else if Button = mbLeft then
  2944.   begin
  2945.     CalcDrawInfo(DrawInfo);
  2946.     { Check grid sizing }
  2947.     CalcSizingState(X, Y, FGridState, FSizingIndex, FSizingPos, FSizingOfs,
  2948.       DrawInfo);
  2949.     if FGridState <> gsNormal then
  2950.     begin
  2951.       DrawSizingLine(DrawInfo);
  2952.       Exit;
  2953.     end;
  2954.     CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  2955.     if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) then
  2956.     begin
  2957.       if goEditing in Options then
  2958.       begin
  2959.         if (CellHit.X = FCurrent.X) and (CellHit.Y = FCurrent.Y) then
  2960.           ShowEditor
  2961.         else
  2962.         begin
  2963.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  2964.           UpdateEdit;
  2965.         end;
  2966.         Click;
  2967.       end
  2968.       else
  2969.       begin
  2970.         FGridState := gsSelecting;
  2971.         SetTimer(Handle, 1, 60, nil);
  2972.         if ssShift in Shift then
  2973.           MoveAnchor(CellHit)
  2974.         else
  2975.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  2976.       end;
  2977.     end
  2978.     else if (goRowMoving in Options) and (CellHit.X >= 0) and
  2979.       (CellHit.X < FixedCols) and (CellHit.Y >= FixedRows) then
  2980.     begin
  2981.       FGridState := gsRowMoving;
  2982.       FMoveIndex := CellHit.Y;
  2983.       FMovePos := FMoveIndex;
  2984.       Update;
  2985.       DrawMove;
  2986.       MoveDrawn := True;
  2987.       SetTimer(Handle, 1, 60, nil);
  2988.     end
  2989.     else if (goColMoving in Options) and (CellHit.Y >= 0) and
  2990.       (CellHit.Y < FixedRows) and (CellHit.X >= FixedCols) then
  2991.     begin
  2992.       FGridState := gsColMoving;
  2993.       FMoveIndex := CellHit.X;
  2994.       FMovePos := FMoveIndex;
  2995.       Update;
  2996.       DrawMove;
  2997.       MoveDrawn := True;
  2998.       SetTimer(Handle, 1, 60, nil);
  2999.     end;
  3000.   end;
  3001.   try
  3002.     inherited MouseDown(Button, Shift, X, Y);
  3003.   except
  3004.     if MoveDrawn then DrawMove;
  3005.   end;
  3006. end;
  3007.  
  3008. procedure TCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
  3009. var
  3010.   DrawInfo: TGridDrawInfo;
  3011.   CellHit: TGridCoord;
  3012. begin
  3013.   CalcDrawInfo(DrawInfo);
  3014.   case FGridState of
  3015.     gsSelecting, gsColMoving, gsRowMoving:
  3016.       begin
  3017.         CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  3018.         if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) and
  3019.           (CellHit.X <= DrawInfo.Horz.LastFullVisibleCell+1) and
  3020.           (CellHit.Y <= DrawInfo.Vert.LastFullVisibleCell+1) then
  3021.           case FGridState of
  3022.             gsSelecting:
  3023.               if ((CellHit.X <> FAnchor.X) or (CellHit.Y <> FAnchor.Y)) then
  3024.                 MoveAnchor(CellHit);
  3025.             gsColMoving:
  3026.               MoveAndScroll(X, CellHit.X, DrawInfo, DrawInfo.Horz, SB_HORZ);
  3027.             gsRowMoving:
  3028.               MoveAndScroll(Y, CellHit.Y, DrawInfo, DrawInfo.Vert, SB_VERT);
  3029.           end;
  3030.       end;
  3031.     gsRowSizing, gsColSizing:
  3032.       begin
  3033.         DrawSizingLine(DrawInfo); { XOR it out }
  3034.         if FGridState = gsRowSizing then
  3035.           FSizingPos := Y + FSizingOfs else
  3036.           FSizingPos := X + FSizingOfs;
  3037.         DrawSizingLine(DrawInfo); { XOR it back in }
  3038.       end;
  3039.   end;
  3040.   inherited MouseMove(Shift, X, Y);
  3041. end;
  3042.  
  3043. procedure TCustomGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  3044.   X, Y: Integer);
  3045. var
  3046.   DrawInfo: TGridDrawInfo;
  3047.   NewSize: Integer;
  3048.  
  3049.   function ResizeLine(const AxisInfo: TGridAxisDrawInfo): Integer;
  3050.   var
  3051.     I: Integer;
  3052.   begin
  3053.     with AxisInfo do
  3054.     begin
  3055.       Result := FixedBoundary;
  3056.       for I := FirstGridCell to FSizingIndex - 1 do
  3057.         Inc(Result, GetExtent(I) + EffectiveLineWidth);
  3058.       Result := FSizingPos - Result;
  3059.     end;
  3060.   end;
  3061.  
  3062. begin
  3063.   try
  3064.     case FGridState of
  3065.       gsSelecting:
  3066.         begin
  3067.           MouseMove(Shift, X, Y);
  3068.           KillTimer(Handle, 1);
  3069.           UpdateEdit;
  3070.           Click;
  3071.         end;
  3072.       gsRowSizing, gsColSizing:
  3073.         begin
  3074.           CalcDrawInfo(DrawInfo);
  3075.           DrawSizingLine(DrawInfo);
  3076.           if FGridState = gsColSizing then
  3077.           begin
  3078.             NewSize := ResizeLine(DrawInfo.Horz);
  3079.             if NewSize > 1 then
  3080.             begin
  3081.               ColWidths[FSizingIndex] := NewSize;
  3082.               UpdateDesigner;
  3083.             end;
  3084.           end
  3085.           else
  3086.           begin
  3087.             NewSize := ResizeLine(DrawInfo.Vert);
  3088.             if NewSize > 1 then
  3089.             begin
  3090.               RowHeights[FSizingIndex] := NewSize;
  3091.               UpdateDesigner;
  3092.             end;
  3093.           end;
  3094.         end;
  3095.       gsColMoving, gsRowMoving:
  3096.         begin
  3097.           DrawMove;
  3098.           KillTimer(Handle, 1);
  3099.           if FMoveIndex <> FMovePos then
  3100.           begin
  3101.             if FGridState = gsColMoving then
  3102.               MoveColumn(FMoveIndex, FMovePos)
  3103.             else
  3104.               MoveRow(FMoveIndex, FMovePos);
  3105.             UpdateDesigner;
  3106.           end;
  3107.           UpdateEdit;
  3108.         end;
  3109.     else
  3110.       UpdateEdit;
  3111.     end;
  3112.     inherited MouseUp(Button, Shift, X, Y);
  3113.   finally
  3114.     FGridState := gsNormal;
  3115.   end;
  3116. end;
  3117.  
  3118. procedure TCustomGrid.MoveAndScroll(Mouse, CellHit: Integer;
  3119.   var DrawInfo: TGridDrawInfo; var Axis: TGridAxisDrawInfo; ScrollBar: Integer);
  3120. begin
  3121.   if (CellHit <> FMovePos) and
  3122.     not((FMovePos = Axis.FixedCellCount) and (Mouse < Axis.FixedBoundary)) and
  3123.     not((FMovePos = Axis.GridCellCount-1) and (Mouse > Axis.GridBoundary)) then
  3124.   begin
  3125.     DrawMove;
  3126.     if (Mouse < Axis.FixedBoundary) then
  3127.     begin
  3128.       if (FMovePos > Axis.FixedCellCount) then
  3129.       begin
  3130.         ModifyScrollbar(ScrollBar, SB_LINEUP, 0);
  3131.         Update;
  3132.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3133.       end;
  3134.       CellHit := Axis.FirstGridCell;
  3135.     end
  3136.     else if (Mouse >= Axis.FullVisBoundary) then
  3137.     begin
  3138.       if (FMovePos = Axis.LastFullVisibleCell) and
  3139.         (FMovePos < Axis.GridCellCount -1) then
  3140.       begin
  3141.         ModifyScrollBar(Scrollbar, SB_LINEDOWN, 0);
  3142.         Update;
  3143.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3144.       end;
  3145.       CellHit := Axis.LastFullVisibleCell;
  3146.     end
  3147.     else if CellHit < 0 then CellHit := FMovePos;
  3148.     FMovePos := CellHit;
  3149.     DrawMove;
  3150.   end;
  3151. end;
  3152.  
  3153. function TCustomGrid.GetColWidths(Index: Longint): Integer;
  3154. begin
  3155.   if (FColWidths = nil) or (Index >= ColCount) then
  3156.     Result := DefaultColWidth
  3157.   else
  3158.     Result := PIntArray(FColWidths)^[Index + 1];
  3159. end;
  3160.  
  3161. function TCustomGrid.GetRowHeights(Index: Longint): Integer;
  3162. begin
  3163.   if (FRowHeights = nil) or (Index >= RowCount) then
  3164.     Result := DefaultRowHeight
  3165.   else
  3166.     Result := PIntArray(FRowHeights)^[Index + 1];
  3167. end;
  3168.  
  3169. function TCustomGrid.GetGridWidth: Integer;
  3170. var
  3171.   DrawInfo: TGridDrawInfo;
  3172. begin
  3173.   CalcDrawInfo(DrawInfo);
  3174.   Result := DrawInfo.Horz.GridBoundary;
  3175. end;
  3176.  
  3177. function TCustomGrid.GetGridHeight: Integer;
  3178. var
  3179.   DrawInfo: TGridDrawInfo;
  3180. begin
  3181.   CalcDrawInfo(DrawInfo);
  3182.   Result := DrawInfo.Vert.GridBoundary;
  3183. end;
  3184.  
  3185. function TCustomGrid.GetSelection: TGridRect;
  3186. begin
  3187.   Result := GridRect(FCurrent, FAnchor);
  3188. end;
  3189.  
  3190. function TCustomGrid.GetTabStops(Index: Longint): Boolean;
  3191. begin
  3192.   if FTabStops = nil then Result := True
  3193.   else Result := Boolean(PIntArray(FTabStops)^[Index + 1]);
  3194. end;
  3195.  
  3196. function TCustomGrid.GetVisibleColCount: Integer;
  3197. var
  3198.   DrawInfo: TGridDrawInfo;
  3199. begin
  3200.   CalcDrawInfo(DrawInfo);
  3201.   Result := DrawInfo.Horz.LastFullVisibleCell - LeftCol + 1;
  3202. end;
  3203.  
  3204. function TCustomGrid.GetVisibleRowCount: Integer;
  3205. var
  3206.   DrawInfo: TGridDrawInfo;
  3207. begin
  3208.   CalcDrawInfo(DrawInfo);
  3209.   Result := DrawInfo.Vert.LastFullVisibleCell - TopRow + 1;
  3210. end;
  3211.  
  3212. procedure TCustomGrid.SetBorderStyle(Value: TBorderStyle);
  3213. begin
  3214.   if FBorderStyle <> Value then
  3215.   begin
  3216.     FBorderStyle := Value;
  3217.     RecreateWnd;
  3218.   end;
  3219. end;
  3220.  
  3221. procedure TCustomGrid.SetCol(Value: Longint);
  3222. begin
  3223.   if Col <> Value then FocusCell(Value, Row, True);
  3224. end;
  3225.  
  3226. procedure TCustomGrid.SetColCount(Value: Longint);
  3227. begin
  3228.   if FColCount <> Value then
  3229.   begin
  3230.     if Value < 1 then Value := 1;
  3231.     if Value <= FixedCols then FixedCols := Value - 1;
  3232.     ChangeSize(Value, RowCount);
  3233.     if goRowSelect in Options then
  3234.     begin
  3235.       FAnchor.X := ColCount - 1;
  3236.       Invalidate;
  3237.     end;
  3238.   end;
  3239. end;
  3240.  
  3241. procedure TCustomGrid.SetColWidths(Index: Longint; Value: Integer);
  3242. begin
  3243.   if FColWidths = nil then
  3244.     UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  3245.   if Index >= ColCount then InvalidOp(SIndexOutOfRange);
  3246.   if Value <> PIntArray(FColWidths)^[Index + 1] then
  3247.   begin
  3248.     ResizeCol(Index, PIntArray(FColWidths)^[Index + 1], Value);
  3249.     PIntArray(FColWidths)^[Index + 1] := Value;
  3250.     ColWidthsChanged;
  3251.   end;
  3252. end;
  3253.  
  3254. procedure TCustomGrid.SetDefaultColWidth(Value: Integer);
  3255. begin
  3256.   if FColWidths <> nil then UpdateExtents(FColWidths, 0, 0);
  3257.   FDefaultColWidth := Value;
  3258.   ColWidthsChanged;
  3259.   InvalidateGrid;
  3260. end;
  3261.  
  3262. procedure TCustomGrid.SetDefaultRowHeight(Value: Integer);
  3263. begin
  3264.   if FRowHeights <> nil then UpdateExtents(FRowHeights, 0, 0);
  3265.   FDefaultRowHeight := Value;
  3266.   RowHeightsChanged;
  3267.   InvalidateGrid;
  3268. end;
  3269.  
  3270. procedure TCustomGrid.SetFixedColor(Value: TColor);
  3271. begin
  3272.   if FFixedColor <> Value then
  3273.   begin
  3274.     FFixedColor := Value;
  3275.     InvalidateGrid;
  3276.   end;
  3277. end;
  3278.  
  3279. procedure TCustomGrid.SetFixedCols(Value: Integer);
  3280. begin
  3281.   if FFixedCols <> Value then
  3282.   begin
  3283.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3284.     if Value >= ColCount then InvalidOp(SFixedColTooBig);
  3285.     FFixedCols := Value;
  3286.     Initialize;
  3287.     InvalidateGrid;
  3288.   end;
  3289. end;
  3290.  
  3291. procedure TCustomGrid.SetFixedRows(Value: Integer);
  3292. begin
  3293.   if FFixedRows <> Value then
  3294.   begin
  3295.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3296.     if Value >= RowCount then InvalidOp(SFixedRowTooBig);
  3297.     FFixedRows := Value;
  3298.     Initialize;
  3299.     InvalidateGrid;
  3300.   end;
  3301. end;
  3302.  
  3303. procedure TCustomGrid.SetEditorMode(Value: Boolean);
  3304. begin
  3305.   if not Value then
  3306.     HideEditor
  3307.   else
  3308.   begin
  3309.     ShowEditor;
  3310.     if FInplaceEdit <> nil then FInplaceEdit.Deselect;
  3311.   end;
  3312. end;
  3313.  
  3314. procedure TCustomGrid.SetGridLineWidth(Value: Integer);
  3315. begin
  3316.   if FGridLineWidth <> Value then
  3317.   begin
  3318.     FGridLineWidth := Value;
  3319.     InvalidateGrid;
  3320.   end;
  3321. end;
  3322.  
  3323. procedure TCustomGrid.SetLeftCol(Value: Longint);
  3324. begin
  3325.   if FTopLeft.X <> Value then MoveTopLeft(Value, TopRow);
  3326. end;
  3327.  
  3328. procedure TCustomGrid.SetOptions(Value: TGridOptions);
  3329. begin
  3330.   if FOptions <> Value then
  3331.   begin
  3332.     if goRowSelect in Value then
  3333.       Exclude(Value, goAlwaysShowEditor);
  3334.     FOptions := Value;
  3335.     if not FEditorMode then
  3336.       if goAlwaysShowEditor in Value then
  3337.         ShowEditor else
  3338.         HideEditor;
  3339.     if goRowSelect in Value then MoveCurrent(Col, Row,  True, False);
  3340.     InvalidateGrid;
  3341.   end;
  3342. end;
  3343.  
  3344. procedure TCustomGrid.SetRow(Value: Longint);
  3345. begin
  3346.   if Row <> Value then FocusCell(Col, Value, True);
  3347. end;
  3348.  
  3349. procedure TCustomGrid.SetRowCount(Value: Longint);
  3350. begin
  3351.   if FRowCount <> Value then
  3352.   begin
  3353.     if Value < 1 then Value := 1;
  3354.     if Value <= FixedRows then FixedRows := Value - 1;
  3355.     ChangeSize(ColCount, Value);
  3356.   end;
  3357. end;
  3358.  
  3359. procedure TCustomGrid.SetRowHeights(Index: Longint; Value: Integer);
  3360. begin
  3361.   if FRowHeights = nil then
  3362.     UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  3363.   if Index >= RowCount then InvalidOp(SIndexOutOfRange);
  3364.   if Value <> PIntArray(FRowHeights)^[Index + 1] then
  3365.   begin
  3366.     ResizeRow(Index, PIntArray(FRowHeights)^[Index + 1], Value);
  3367.     PIntArray(FRowHeights)^[Index + 1] := Value;
  3368.     RowHeightsChanged;
  3369.   end;
  3370. end;
  3371.  
  3372. procedure TCustomGrid.SetScrollBars(Value: TScrollStyle);
  3373. begin
  3374.   if FScrollBars <> Value then
  3375.   begin
  3376.     FScrollBars := Value;
  3377.     RecreateWnd;
  3378.   end;
  3379. end;
  3380.  
  3381. procedure TCustomGrid.SetSelection(Value: TGridRect);
  3382. var
  3383.   OldSel: TGridRect;
  3384. begin
  3385.   OldSel := Selection;
  3386.   FAnchor := Value.TopLeft;
  3387.   FCurrent := Value.BottomRight;
  3388.   SelectionMoved(OldSel);
  3389. end;
  3390.  
  3391. procedure TCustomGrid.SetTabStops(Index: Longint; Value: Boolean);
  3392. begin
  3393.   if FTabStops = nil then
  3394.     UpdateExtents(FTabStops, ColCount, Integer(True));
  3395.   if Index >= ColCount then InvalidOp(SIndexOutOfRange);
  3396.   PIntArray(FTabStops)^[Index + 1] := Integer(Value);
  3397. end;
  3398.  
  3399. procedure TCustomGrid.SetTopRow(Value: Longint);
  3400. begin
  3401.   if FTopLeft.Y <> Value then MoveTopLeft(LeftCol, Value);
  3402. end;
  3403.  
  3404. procedure TCustomGrid.HideEdit;
  3405. begin
  3406.   if FInplaceEdit <> nil then
  3407.     try
  3408.       UpdateText;
  3409.     finally
  3410.       FInplaceCol := -1;
  3411.       FInplaceRow := -1;
  3412.       FInplaceEdit.Hide;
  3413.     end;
  3414. end;
  3415.  
  3416. procedure TCustomGrid.UpdateEdit;
  3417.  
  3418.   procedure UpdateEditor;
  3419.   begin
  3420.     FInplaceCol := Col;
  3421.     FInplaceRow := Row;
  3422.     FInplaceEdit.UpdateContents;
  3423.     if FInplaceEdit.MaxLength = -1 then FCanEditModify := False
  3424.     else FCanEditModify := True;
  3425.     FInplaceEdit.SelectAll;
  3426.   end;
  3427.  
  3428. begin
  3429.   if CanEditShow then
  3430.   begin
  3431.     if FInplaceEdit = nil then
  3432.     begin
  3433.       FInplaceEdit := CreateEditor;
  3434.       FInplaceEdit.SetGrid(Self);
  3435.       FInplaceEdit.Parent := Self;
  3436.       UpdateEditor;
  3437.     end
  3438.     else
  3439.     begin
  3440.       if (Col <> FInplaceCol) or (Row <> FInplaceRow) then
  3441.       begin
  3442.         HideEdit;
  3443.         UpdateEditor;
  3444.       end;
  3445.     end;
  3446.     if CanEditShow then FInplaceEdit.Move(CellRect(Col, Row));
  3447.   end;
  3448. end;
  3449.  
  3450. procedure TCustomGrid.UpdateText;
  3451. begin
  3452.   if (FInplaceCol <> -1) and (FInplaceRow <> -1) then
  3453.     SetEditText(FInplaceCol, FInplaceRow, FInplaceEdit.Text);
  3454. end;
  3455.  
  3456. procedure TCustomGrid.WMChar(var Msg: TWMChar);
  3457. begin
  3458.   if (goEditing in Options) and (Char(Msg.CharCode) in [^H, #32..#255]) then
  3459.     ShowEditorChar(Char(Msg.CharCode))
  3460.   else
  3461.     inherited;
  3462. end;
  3463.  
  3464. procedure TCustomGrid.WMCommand(var Message: TWMCommand);
  3465. begin
  3466.   with Message do
  3467.   begin
  3468.     if (FInplaceEdit <> nil) and (Ctl = FInplaceEdit.Handle) then
  3469.       case NotifyCode of
  3470.         EN_CHANGE: UpdateText;
  3471.       end;
  3472.   end;
  3473. end;
  3474.  
  3475. procedure TCustomGrid.WMGetDlgCode(var Msg: TWMGetDlgCode);
  3476. begin
  3477.   Msg.Result := DLGC_WANTARROWS;
  3478.   if goRowSelect in Options then Exit;
  3479.   if goTabs in Options then Msg.Result := Msg.Result or DLGC_WANTTAB;
  3480.   if goEditing in Options then Msg.Result := Msg.Result or DLGC_WANTCHARS;
  3481. end;
  3482.  
  3483. procedure TCustomGrid.WMKillFocus(var Msg: TWMKillFocus);
  3484. begin
  3485.   inherited;
  3486.   InvalidateRect(Selection);
  3487.   if (FInplaceEdit <> nil) and (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3488.     HideEdit;
  3489. end;
  3490.  
  3491. procedure TCustomGrid.WMLButtonDown(var Message: TMessage);
  3492. begin
  3493.   inherited;
  3494.   if FInplaceEdit <> nil then FInplaceEdit.FClickTime := GetMessageTime;
  3495. end;
  3496.  
  3497. procedure TCustomGrid.WMNCHitTest(var Msg: TWMNCHitTest);
  3498. begin
  3499.   DefaultHandler(Msg);
  3500.   FHitTest := ScreenToClient(SmallPointToPoint(Msg.Pos));
  3501. end;
  3502.  
  3503. procedure TCustomGrid.WMSetCursor(var Msg: TWMSetCursor);
  3504. var
  3505.   FixedInfo: TGridDrawInfo;
  3506.   State: TGridState;
  3507.   Index: Longint;
  3508.   Pos, Ofs: Integer;
  3509.   Cur: HCURSOR;
  3510. begin
  3511.   Cur := 0;
  3512.   with Msg do
  3513.   begin
  3514.     if HitTest = HTCLIENT then
  3515.     begin
  3516.       if FGridState = gsNormal then
  3517.       begin
  3518.         CalcFixedInfo(FixedInfo);
  3519.         CalcSizingState(FHitTest.X, FHitTest.Y, State, Index, Pos, Ofs,
  3520.           FixedInfo);
  3521.       end else State := FGridState;
  3522.       if State = gsRowSizing then
  3523.         Cur := Screen.Cursors[crVSplit]
  3524.       else if State = gsColSizing then
  3525.         Cur := Screen.Cursors[crHSplit]
  3526.     end;
  3527.   end;
  3528.   if Cur <> 0 then SetCursor(Cur)
  3529.   else inherited;
  3530. end;
  3531.  
  3532. procedure TCustomGrid.WMSetFocus(var Msg: TWMSetFocus);
  3533. begin
  3534.   inherited;
  3535.   if (FInplaceEdit = nil) or (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3536.   begin
  3537.     InvalidateRect(Selection);
  3538.     UpdateEdit;
  3539.   end;
  3540. end;
  3541.  
  3542. procedure TCustomGrid.WMSize(var Msg: TWMSize);
  3543. begin
  3544.   inherited;
  3545.   UpdateScrollRange;
  3546. end;
  3547.  
  3548. procedure TCustomGrid.WMVScroll(var Msg: TWMVScroll);
  3549. begin
  3550.   ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos);
  3551. end;
  3552.  
  3553. procedure TCustomGrid.WMHScroll(var Msg: TWMHScroll);
  3554. begin
  3555.   ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos);
  3556. end;
  3557.  
  3558. procedure TCustomGrid.CMCancelMode(var Msg: TMessage);
  3559. begin
  3560.   if Assigned(FInplaceEdit) then FInplaceEdit.WndProc(Msg);
  3561.   inherited;
  3562. end;
  3563.  
  3564. procedure TCustomGrid.CMFontChanged(var Message: TMessage);
  3565. begin
  3566.   if FInplaceEdit <> nil then FInplaceEdit.Font := Font;
  3567.   inherited;
  3568. end;
  3569.  
  3570. procedure TCustomGrid.CMCtl3DChanged(var Message: TMessage);
  3571. begin
  3572.   inherited;
  3573.   RecreateWnd;
  3574. end;
  3575.  
  3576. procedure TCustomGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
  3577. begin
  3578.   Msg.Result := Longint(BOOL(Sizing(Msg.Pos.X, Msg.Pos.Y)));
  3579. end;
  3580.  
  3581. procedure TCustomGrid.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
  3582. begin
  3583.   inherited;
  3584.   if (goEditing in Options) and (Char(Msg.CharCode) = #13) then Msg.Result := 1;
  3585. end;
  3586.  
  3587. procedure TCustomGrid.TimedScroll(Direction: TGridScrollDirection);
  3588. var
  3589.   MaxAnchor, NewAnchor: TGridCoord;
  3590. begin
  3591.   NewAnchor := FAnchor;
  3592.   MaxAnchor.X := ColCount - 1;
  3593.   MaxAnchor.Y := RowCount - 1;
  3594.   if (sdLeft in Direction) and (FAnchor.X > FixedCols) then Dec(NewAnchor.X);
  3595.   if (sdRight in Direction) and (FAnchor.X < MaxAnchor.X) then Inc(NewAnchor.X);
  3596.   if (sdUp in Direction) and (FAnchor.Y > FixedRows) then Dec(NewAnchor.Y);
  3597.   if (sdDown in Direction) and (FAnchor.Y < MaxAnchor.Y) then Inc(NewAnchor.Y);
  3598.   if (FAnchor.X <> NewAnchor.X) or (FAnchor.Y <> NewAnchor.Y) then
  3599.     MoveAnchor(NewAnchor);
  3600. end;
  3601.  
  3602. procedure TCustomGrid.WMTimer(var Msg: TWMTimer);
  3603. var
  3604.   Point: TPoint;
  3605.   DrawInfo: TGridDrawInfo;
  3606.   ScrollDirection: TGridScrollDirection;
  3607.   CellHit: TGridCoord;
  3608. begin
  3609.   if not (FGridState in [gsSelecting, gsRowMoving, gsColMoving]) then Exit;
  3610.   GetCursorPos(Point);
  3611.   Point := ScreenToClient(Point);
  3612.   CalcDrawInfo(DrawInfo);
  3613.   ScrollDirection := [];
  3614.   with DrawInfo do
  3615.   begin
  3616.     CellHit := CalcCoordFromPoint(Point.X, Point.Y, DrawInfo);
  3617.     case FGridState of
  3618.       gsColMoving:
  3619.         MoveAndScroll(Point.X, CellHit.X, DrawInfo, Horz, SB_HORZ);
  3620.       gsRowMoving:
  3621.         MoveAndScroll(Point.Y, CellHit.Y, DrawInfo, Vert, SB_VERT);
  3622.       gsSelecting:
  3623.       begin
  3624.         if Point.X < Horz.FixedBoundary then Include(ScrollDirection, sdLeft)
  3625.         else if Point.X > Horz.FullVisBoundary then Include(ScrollDirection, sdRight);
  3626.         if Point.Y < Vert.FixedBoundary then Include(ScrollDirection, sdUp)
  3627.         else if Point.Y > Vert.FullVisBoundary then Include(ScrollDirection, sdDown);
  3628.         if ScrollDirection <> [] then  TimedScroll(ScrollDirection);
  3629.       end;
  3630.     end;
  3631.   end;
  3632. end;
  3633.  
  3634. procedure TCustomGrid.ColWidthsChanged;
  3635. begin
  3636.   UpdateScrollRange;
  3637.   UpdateEdit;
  3638. end;
  3639.  
  3640. procedure TCustomGrid.RowHeightsChanged;
  3641. begin
  3642.   UpdateScrollRange;
  3643.   UpdateEdit;
  3644. end;
  3645.  
  3646. procedure TCustomGrid.DeleteColumn(ACol: Longint);
  3647. begin
  3648.   MoveColumn(ACol, ColCount-1);
  3649.   ColCount := ColCount - 1;
  3650. end;
  3651.  
  3652. procedure TCustomGrid.DeleteRow(ARow: Longint);
  3653. begin
  3654.   MoveRow(ARow, RowCount - 1);
  3655.   RowCount := RowCount - 1;
  3656. end;
  3657.  
  3658. procedure TCustomGrid.UpdateDesigner;
  3659. var
  3660.   ParentForm: TCustomForm;
  3661. begin
  3662.   if (csDesigning in ComponentState) and HandleAllocated and
  3663.     not (csUpdating in ComponentState) then
  3664.   begin
  3665.     ParentForm := GetParentForm(Self);
  3666.     if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
  3667.       ParentForm.Designer.Modified;
  3668.   end;
  3669. end;
  3670.  
  3671. { TDrawGrid }
  3672.  
  3673. function TDrawGrid.CellRect(ACol, ARow: Longint): TRect;
  3674. begin
  3675.   Result := inherited CellRect(ACol, ARow);
  3676. end;
  3677.  
  3678. procedure TDrawGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  3679. var
  3680.   Coord: TGridCoord;
  3681. begin
  3682.   Coord := MouseCoord(X, Y);
  3683.   ACol := Coord.X;
  3684.   ARow := Coord.Y;
  3685. end;
  3686.  
  3687. procedure TDrawGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  3688. begin
  3689.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  3690. end;
  3691.  
  3692. function TDrawGrid.GetEditMask(ACol, ARow: Longint): string;
  3693. begin
  3694.   Result := '';
  3695.   if Assigned(FOnGetEditMask) then FOnGetEditMask(Self, ACol, ARow, Result);
  3696. end;
  3697.  
  3698. function TDrawGrid.GetEditText(ACol, ARow: Longint): string;
  3699. begin
  3700.   Result := '';
  3701.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  3702. end;
  3703.  
  3704. procedure TDrawGrid.RowMoved(FromIndex, ToIndex: Longint);
  3705. begin
  3706.   if Assigned(FOnRowMoved) then FOnRowMoved(Self, FromIndex, ToIndex);
  3707. end;
  3708.  
  3709. function TDrawGrid.SelectCell(ACol, ARow: Longint): Boolean;
  3710. begin
  3711.   Result := True;
  3712.   if Assigned(FOnSelectCell) then FOnSelectCell(Self, ACol, ARow, Result);
  3713. end;
  3714.  
  3715. procedure TDrawGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  3716. begin
  3717.   if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
  3718. end;
  3719.  
  3720. procedure TDrawGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  3721.   AState: TGridDrawState);
  3722. begin
  3723.   if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, AState);
  3724. end;
  3725.  
  3726. procedure TDrawGrid.TopLeftChanged;
  3727. begin
  3728.   inherited TopLeftChanged;
  3729.   if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
  3730. end;
  3731.  
  3732. { StrItem management for TStringSparseList }
  3733.  
  3734. type
  3735.   PStrItem = ^TStrItem;
  3736.   TStrItem = record
  3737.     FObject: TObject;
  3738.     FString: string;
  3739.   end;
  3740.  
  3741. function NewStrItem(const AString: string; AObject: TObject): PStrItem;
  3742. begin
  3743.   New(Result);
  3744.   Result^.FObject := AObject;
  3745.   Result^.FString := AString;
  3746. end;
  3747.  
  3748. procedure DisposeStrItem(P: PStrItem);
  3749. begin
  3750.   Dispose(P);
  3751. end;
  3752.  
  3753. { Sparse array classes for TStringGrid }
  3754.  
  3755. type
  3756.  
  3757.   PPointer = ^Pointer;
  3758.  
  3759. { Exception classes }
  3760.  
  3761.   EStringSparseListError = class(Exception);
  3762.  
  3763. { TSparsePointerArray class}
  3764.  
  3765. { Used by TSparseList.  Based on Sparse1Array, but has Pointer elements
  3766.   and Integer index, just like TPointerList/TList, and less indirection }
  3767.  
  3768.   { Apply function for the applicator:
  3769.         TheIndex        Index of item in array
  3770.         TheItem         Value of item (i.e pointer element) in section
  3771.         Returns: 0 if success, else error code. }
  3772.   TSPAApply = function(TheIndex: Integer; TheItem: Pointer): Integer;
  3773.  
  3774.   TSecDir = array[0..4095] of Pointer;  { Enough for up to 12 bits of sec }
  3775.   PSecDir = ^TSecDir;
  3776.   TSPAQuantum = (SPASmall, SPALarge);   { Section size }
  3777.  
  3778.   TSparsePointerArray = class(TObject)
  3779.   private
  3780.     secDir: PSecDir;
  3781.     slotsInDir: Word;
  3782.     indexMask, secShift: Word;
  3783.     FHighBound: Integer;
  3784.     FSectionSize: Word;
  3785.     cachedIndex: Integer;
  3786.     cachedPointer: Pointer;
  3787.     { Return item[i], nil if slot outside defined section. }
  3788.     function  GetAt(Index: Integer): Pointer;
  3789.     { Return address of item[i], creating slot if necessary. }
  3790.     function  MakeAt(Index: Integer): PPointer;
  3791.     { Store item at item[i], creating slot if necessary. }
  3792.     procedure PutAt(Index: Integer; Item: Pointer);
  3793.   public
  3794.     constructor Create(Quantum: TSPAQuantum);
  3795.     destructor  Destroy; override;
  3796.  
  3797.     { Traverse SPA, calling apply function for each defined non-nil
  3798.       item.  The traversal terminates if the apply function returns
  3799.       a value other than 0. }
  3800.     { NOTE: must be static method so that we can take its address in
  3801.       TSparseList.ForAll }
  3802.     function  ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  3803.  
  3804.     { Ratchet down HighBound after a deletion }
  3805.     procedure ResetHighBound;
  3806.  
  3807.     property HighBound: Integer read FHighBound;
  3808.     property SectionSize: Word read FSectionSize;
  3809.     property Items[Index: Integer]: Pointer read GetAt write PutAt; default;
  3810.   end;
  3811.  
  3812. { TSparseList class }
  3813.  
  3814.   TSparseList = class(TObject)
  3815.   private
  3816.     FList: TSparsePointerArray;
  3817.     FCount: Integer;    { 1 + HighBound, adjusted for Insert/Delete }
  3818.     FQuantum: TSPAQuantum;
  3819.     procedure NewList(Quantum: TSPAQuantum);
  3820.   protected
  3821.     procedure Error; virtual;
  3822.     function  Get(Index: Integer): Pointer;
  3823.     procedure Put(Index: Integer; Item: Pointer);
  3824.   public
  3825.     constructor Create(Quantum: TSPAQuantum);
  3826.     destructor  Destroy; override;
  3827.     procedure Clear;
  3828.     procedure Delete(Index: Integer);
  3829.     procedure Exchange(Index1, Index2: Integer);
  3830.     function ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  3831.     procedure Insert(Index: Integer; Item: Pointer);
  3832.     procedure Move(CurIndex, NewIndex: Integer);
  3833.     property Count: Integer read FCount;
  3834.     property Items[Index: Integer]: Pointer read Get write Put; default;
  3835.   end;
  3836.  
  3837. { TStringSparseList class }
  3838.  
  3839.   TStringSparseList = class(TStrings)
  3840.   private
  3841.     FList: TSparseList;                 { of StrItems }
  3842.     FOnChange: TNotifyEvent;
  3843.   protected
  3844.     function  Get(Index: Integer): String; override;
  3845.     function  GetCount: Integer; override;
  3846.     function  GetObject(Index: Integer): TObject; override;
  3847.     procedure Put(Index: Integer; const S: String); override;
  3848.     procedure PutObject(Index: Integer; AObject: TObject); override;
  3849.     procedure Changed; virtual;
  3850.     procedure Error; virtual;
  3851.   public
  3852.     constructor Create(Quantum: TSPAQuantum);
  3853.     destructor  Destroy; override;
  3854.     procedure ReadData(Reader: TReader);
  3855.     procedure WriteData(Writer: TWriter);
  3856.     procedure DefineProperties(Filer: TFiler); override;
  3857.     procedure Delete(Index: Integer); override;
  3858.     procedure Exchange(Index1, Index2: Integer); override;
  3859.     procedure Insert(Index: Integer; const S: String); override;
  3860.     procedure Clear; override;
  3861.     property List: TSparseList read FList;
  3862.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  3863.   end;
  3864.  
  3865. { TSparsePointerArray }
  3866.  
  3867. const
  3868.   SPAIndexMask: array[TSPAQuantum] of Byte = (15, 255);
  3869.   SPASecShift: array[TSPAQuantum] of Byte = (4, 8);
  3870.  
  3871. { Expand Section Directory to cover at least `newSlots' slots. Returns: Possibly
  3872.   updated pointer to the Section Directory. }
  3873. function  ExpandDir(secDir: PSecDir; var slotsInDir: Word;
  3874.   newSlots: Word): PSecDir;
  3875. begin
  3876.   Result := secDir;
  3877.   ReallocMem(Result, newSlots * SizeOf(Pointer));
  3878.   FillChar(Result^[slotsInDir], (newSlots - slotsInDir) * SizeOf(Pointer), 0);
  3879.   slotsInDir := newSlots;
  3880. end;
  3881.  
  3882. { Allocate a section and set all its items to nil. Returns: Pointer to start of
  3883.   section. }
  3884. function  MakeSec(SecIndex: Integer; SectionSize: Word): Pointer;
  3885. var
  3886.   SecP: Pointer;
  3887.   Size: Word;
  3888. begin
  3889.   Size := SectionSize * SizeOf(Pointer);
  3890.   GetMem(secP, size);
  3891.   FillChar(secP^, size, 0);
  3892.   MakeSec := SecP
  3893. end;
  3894.  
  3895. constructor TSparsePointerArray.Create(Quantum: TSPAQuantum);
  3896. begin
  3897.   SecDir := nil;
  3898.   SlotsInDir := 0;
  3899.   FHighBound := -1;
  3900.   FSectionSize := Word(SPAIndexMask[Quantum]) + 1;
  3901.   IndexMask := Word(SPAIndexMask[Quantum]);
  3902.   SecShift := Word(SPASecShift[Quantum]);
  3903.   CachedIndex := -1
  3904. end;
  3905.  
  3906. destructor TSparsePointerArray.Destroy;
  3907. var
  3908.   i:  Integer;
  3909.   size: Word;
  3910. begin
  3911.   { Scan section directory and free each section that exists. }
  3912.   i := 0;
  3913.   size := FSectionSize * SizeOf(Pointer);
  3914.   while i < slotsInDir do begin
  3915.     if secDir^[i] <> nil then
  3916.       FreeMem(secDir^[i], size);
  3917.     Inc(i)
  3918.   end;
  3919.  
  3920.   { Free section directory. }
  3921.   if secDir <> nil then
  3922.     FreeMem(secDir, slotsInDir * SizeOf(Pointer));
  3923. end;
  3924.  
  3925. function  TSparsePointerArray.GetAt(Index: Integer): Pointer;
  3926. var
  3927.   byteP: PChar;
  3928.   secIndex: Cardinal;
  3929. begin
  3930.   { Index into Section Directory using high order part of
  3931.     index.  Get pointer to Section. If not null, index into
  3932.     Section using low order part of index. }
  3933.   if Index = cachedIndex then
  3934.     Result := cachedPointer
  3935.   else begin
  3936.     secIndex := Index shr secShift;
  3937.     if secIndex >= slotsInDir then
  3938.       byteP := nil
  3939.     else begin
  3940.       byteP := secDir^[secIndex];
  3941.       if byteP <> nil then begin
  3942.         Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  3943.       end
  3944.     end;
  3945.     if byteP = nil then Result := nil else Result := PPointer(byteP)^;
  3946.     cachedIndex := Index;
  3947.     cachedPointer := Result
  3948.   end
  3949. end;
  3950.  
  3951. function  TSparsePointerArray.MakeAt(Index: Integer): PPointer;
  3952. var
  3953.   dirP: PSecDir;
  3954.   p: Pointer;
  3955.   byteP: PChar;
  3956.   secIndex: Word;
  3957. begin
  3958.   { Expand Section Directory if necessary. }
  3959.   secIndex := Index shr secShift;       { Unsigned shift }
  3960.   if secIndex >= slotsInDir then
  3961.     dirP := expandDir(secDir, slotsInDir, secIndex + 1)
  3962.   else
  3963.     dirP := secDir;
  3964.  
  3965.   { Index into Section Directory using high order part of
  3966.     index.  Get pointer to Section. If null, create new
  3967.     Section.  Index into Section using low order part of index. }
  3968.   secDir := dirP;
  3969.   p := dirP^[secIndex];
  3970.   if p = nil then begin
  3971.     p := makeSec(secIndex, FSectionSize);
  3972.     dirP^[secIndex] := p
  3973.   end;
  3974.   byteP := p;
  3975.   Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  3976.   if Index > FHighBound then
  3977.     FHighBound := Index;
  3978.   Result := PPointer(byteP);
  3979.   cachedIndex := -1
  3980. end;
  3981.  
  3982. procedure TSparsePointerArray.PutAt(Index: Integer; Item: Pointer);
  3983. begin
  3984.   if (Item <> nil) or (GetAt(Index) <> nil) then
  3985.   begin
  3986.     MakeAt(Index)^ := Item;
  3987.     if Item = nil then
  3988.       ResetHighBound
  3989.   end
  3990. end;
  3991.  
  3992. function  TSparsePointerArray.ForAll(ApplyFunction: Pointer {TSPAApply}):
  3993.   Integer;
  3994. var
  3995.   itemP: PChar;                         { Pointer to item in section }
  3996.   item: Pointer;
  3997.   i, callerBP: Cardinal;
  3998.   j, index: Integer;
  3999. begin
  4000.   { Scan section directory and scan each section that exists,
  4001.     calling the apply function for each non-nil item.
  4002.     The apply function must be a far local function in the scope of
  4003.     the procedure P calling ForAll.  The trick of setting up the stack
  4004.     frame (taken from TurboVision's TCollection.ForEach) allows the
  4005.     apply function access to P's arguments and local variables and,
  4006.     if P is a method, the instance variables and methods of P's class }
  4007.   Result := 0;
  4008.   i := 0;
  4009.   asm
  4010.     mov   eax,[ebp]                     { Set up stack frame for local }
  4011.     mov   callerBP,eax
  4012.   end;
  4013.   while (i < slotsInDir) and (Result = 0) do begin
  4014.     itemP := secDir^[i];
  4015.     if itemP <> nil then begin
  4016.       j := 0;
  4017.       index := i shl SecShift;
  4018.       while (j < FSectionSize) and (Result = 0) do begin
  4019.         item := PPointer(itemP)^;
  4020.         if item <> nil then
  4021.           { ret := ApplyFunction(index, item.Ptr); }
  4022.           asm
  4023.             mov   eax,index
  4024.             mov   edx,item
  4025.             push  callerBP
  4026.             call  ApplyFunction
  4027.             pop   ecx
  4028.             mov   @Result,eax
  4029.           end;
  4030.         Inc(itemP, SizeOf(Pointer));
  4031.         Inc(j);
  4032.         Inc(index)
  4033.       end
  4034.     end;
  4035.     Inc(i)
  4036.   end;
  4037. end;
  4038.  
  4039. procedure TSparsePointerArray.ResetHighBound;
  4040. var
  4041.   NewHighBound: Integer;
  4042.  
  4043.   function  Detector(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4044.   begin
  4045.     if TheIndex > FHighBound then
  4046.       Result := 1
  4047.     else
  4048.     begin
  4049.       Result := 0;
  4050.       if TheItem <> nil then NewHighBound := TheIndex
  4051.     end
  4052.   end;
  4053.  
  4054. begin
  4055.   NewHighBound := -1;
  4056.   ForAll(@Detector);
  4057.   FHighBound := NewHighBound
  4058. end;
  4059.  
  4060. { TSparseList }
  4061.  
  4062. constructor TSparseList.Create(Quantum: TSPAQuantum);
  4063. begin
  4064.   NewList(Quantum)
  4065. end;
  4066.  
  4067. destructor TSparseList.Destroy;
  4068. begin
  4069.   if FList <> nil then FList.Destroy
  4070. end;
  4071.  
  4072.  
  4073. procedure TSparseList.Clear;
  4074. begin
  4075.   FList.Destroy;
  4076.   NewList(FQuantum);
  4077.   FCount := 0
  4078. end;
  4079.  
  4080. procedure TSparseList.Delete(Index: Integer);
  4081. var
  4082.   I: Integer;
  4083. begin
  4084.   if (Index < 0) or (Index >= FCount) then Exit;
  4085.   for I := Index to FCount - 1 do
  4086.     FList[I] := FList[I + 1];
  4087.   FList[FCount] := nil;
  4088.   Dec(FCount);
  4089. end;
  4090.  
  4091. procedure TSparseList.Error;
  4092. begin
  4093.   raise EListError.Create(SListIndexError);
  4094. end;
  4095.  
  4096. procedure TSparseList.Exchange(Index1, Index2: Integer);
  4097. var
  4098.   temp: Pointer;
  4099. begin
  4100.   temp := Get(Index1);
  4101.   Put(Index1, Get(Index2));
  4102.   Put(Index2, temp);
  4103. end;
  4104.  
  4105. { Jump to TSparsePointerArray.ForAll so that it looks like it was called
  4106.   from our caller, so that the BP trick works. }
  4107.  
  4108. function TSparseList.ForAll(ApplyFunction: Pointer {TSPAApply}): Integer; assembler;
  4109. asm
  4110.         MOV     EAX,[EAX].TSparseList.FList
  4111.         JMP     TSparsePointerArray.ForAll
  4112. end;
  4113.  
  4114. function  TSparseList.Get(Index: Integer): Pointer;
  4115. begin
  4116.   if Index < 0 then Error;
  4117.   Result := FList[Index]
  4118. end;
  4119.  
  4120. procedure TSparseList.Insert(Index: Integer; Item: Pointer);
  4121. var
  4122.   i: Integer;
  4123. begin
  4124.   if Index < 0 then Error;
  4125.   I := FCount;
  4126.   while I > Index do
  4127.   begin
  4128.     FList[i] := FList[i - 1];
  4129.     Dec(i)
  4130.   end;
  4131.   FList[Index] := Item;
  4132.   if Index > FCount then FCount := Index;
  4133.   Inc(FCount)
  4134. end;
  4135.  
  4136. procedure TSparseList.Move(CurIndex, NewIndex: Integer);
  4137. var
  4138.   Item: Pointer;
  4139. begin
  4140.   if CurIndex <> NewIndex then
  4141.   begin
  4142.     Item := Get(CurIndex);
  4143.     Delete(CurIndex);
  4144.     Insert(NewIndex, Item);
  4145.   end;
  4146. end;
  4147.  
  4148. procedure TSparseList.NewList(Quantum: TSPAQuantum);
  4149. begin
  4150.   FQuantum := Quantum;
  4151.   FList := TSparsePointerArray.Create(Quantum)
  4152. end;
  4153.  
  4154. procedure TSparseList.Put(Index: Integer; Item: Pointer);
  4155. begin
  4156.   if Index < 0 then Error;
  4157.   FList[Index] := Item;
  4158.   FCount := FList.HighBound + 1
  4159. end;
  4160.  
  4161. { TStringSparseList }
  4162.  
  4163. constructor TStringSparseList.Create(Quantum: TSPAQuantum);
  4164. begin
  4165.   FList := TSparseList.Create(Quantum)
  4166. end;
  4167.  
  4168. destructor  TStringSparseList.Destroy;
  4169. begin
  4170.   if FList <> nil then begin
  4171.     Clear;
  4172.     FList.Destroy
  4173.   end
  4174. end;
  4175.  
  4176. procedure TStringSparseList.ReadData(Reader: TReader);
  4177. var
  4178.   i: Integer;
  4179. begin
  4180.   with Reader do begin
  4181.     i := Integer(ReadInteger);
  4182.     while i > 0 do begin
  4183.       InsertObject(Integer(ReadInteger), ReadString, nil);
  4184.       Dec(i)
  4185.     end
  4186.   end
  4187. end;
  4188.  
  4189. procedure TStringSparseList.WriteData(Writer: TWriter);
  4190. var
  4191.   itemCount: Integer;
  4192.  
  4193.   function  CountItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4194.   begin
  4195.     Inc(itemCount);
  4196.     Result := 0
  4197.   end;
  4198.  
  4199.   function  StoreItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4200.   begin
  4201.     with Writer do
  4202.     begin
  4203.       WriteInteger(TheIndex);           { Item index }
  4204.       WriteString(PStrItem(TheItem)^.FString);
  4205.     end;
  4206.     Result := 0
  4207.   end;
  4208.  
  4209. begin
  4210.   with Writer do
  4211.   begin
  4212.     itemCount := 0;
  4213.     FList.ForAll(@CountItem);
  4214.     WriteInteger(itemCount);
  4215.     FList.ForAll(@StoreItem);
  4216.   end
  4217. end;
  4218.  
  4219. procedure TStringSparseList.DefineProperties(Filer: TFiler);
  4220. begin
  4221.   Filer.DefineProperty('List', ReadData, WriteData, True);
  4222. end;
  4223.  
  4224. function  TStringSparseList.Get(Index: Integer): String;
  4225. var
  4226.   p: PStrItem;
  4227. begin
  4228.   p := PStrItem(FList[Index]);
  4229.   if p = nil then Result := '' else Result := p^.FString
  4230. end;
  4231.  
  4232. function  TStringSparseList.GetCount: Integer;
  4233. begin
  4234.   Result := FList.Count
  4235. end;
  4236.  
  4237. function  TStringSparseList.GetObject(Index: Integer): TObject;
  4238. var
  4239.   p: PStrItem;
  4240. begin
  4241.   p := PStrItem(FList[Index]);
  4242.   if p = nil then Result := nil else Result := p^.FObject
  4243. end;
  4244.  
  4245. procedure TStringSparseList.Put(Index: Integer; const S: String);
  4246. var
  4247.   p: PStrItem;
  4248.   obj: TObject;
  4249. begin
  4250.   p := PStrItem(FList[Index]);
  4251.   if p = nil then obj := nil else obj := p^.FObject;
  4252.   if (S = '') and (obj = nil) then   { Nothing left to store }
  4253.     FList[Index] := nil
  4254.   else
  4255.     FList[Index] := NewStrItem(S, obj);
  4256.   if p <> nil then DisposeStrItem(p);
  4257.   Changed
  4258. end;
  4259.  
  4260. procedure TStringSparseList.PutObject(Index: Integer; AObject: TObject);
  4261. var
  4262.   p: PStrItem;
  4263. begin
  4264.   p := PStrItem(FList[Index]);
  4265.   if p <> nil then
  4266.     p^.FObject := AObject
  4267.   else if AObject <> nil then
  4268.     FList[Index] := NewStrItem('',AObject);
  4269.   Changed
  4270. end;
  4271.  
  4272. procedure TStringSparseList.Changed;
  4273. begin
  4274.   if Assigned(FOnChange) then FOnChange(Self)
  4275. end;
  4276.  
  4277. procedure TStringSparseList.Error;
  4278. begin
  4279.   raise EStringSparseListError.Create(SPutObjectError);
  4280. end;
  4281.  
  4282. procedure TStringSparseList.Delete(Index: Integer);
  4283. var
  4284.   p: PStrItem;
  4285. begin
  4286.   p := PStrItem(FList[Index]);
  4287.   if p <> nil then DisposeStrItem(p);
  4288.   FList.Delete(Index);
  4289.   Changed
  4290. end;
  4291.  
  4292. procedure TStringSparseList.Exchange(Index1, Index2: Integer);
  4293. begin
  4294.   FList.Exchange(Index1, Index2);
  4295. end;
  4296.  
  4297. procedure TStringSparseList.Insert(Index: Integer; const S: String);
  4298. begin
  4299.   FList.Insert(Index, NewStrItem(S, nil));
  4300.   Changed
  4301. end;
  4302.  
  4303. procedure TStringSparseList.Clear;
  4304.  
  4305.   function  ClearItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4306.   begin
  4307.     DisposeStrItem(PStrItem(TheItem));    { Item guaranteed non-nil }
  4308.     Result := 0
  4309.   end;
  4310.  
  4311. begin
  4312.   FList.ForAll(@ClearItem);
  4313.   FList.Clear;
  4314.   Changed
  4315. end;
  4316.  
  4317. { TStringGridStrings }
  4318.  
  4319. { AIndex < 0 is a column (for column -AIndex - 1)
  4320.   AIndex > 0 is a row (for row AIndex - 1)
  4321.   AIndex = 0 denotes an empty row or column }
  4322.  
  4323. constructor TStringGridStrings.Create(AGrid: TStringGrid; AIndex: Longint);
  4324. begin
  4325.   inherited Create;
  4326.   FGrid := AGrid;
  4327.   FIndex := AIndex;
  4328. end;
  4329.  
  4330. procedure TStringGridStrings.Assign(Source: TPersistent);
  4331. var
  4332.   I, Max: Integer;
  4333. begin
  4334.   if Source is TStrings then
  4335.   begin
  4336.     BeginUpdate;
  4337.     Max := TStrings(Source).Count - 1;
  4338.     if Max >= Count then Max := Count - 1;
  4339.     try
  4340.       for I := 0 to Max do
  4341.       begin
  4342.         Put(I, TStrings(Source).Strings[I]);
  4343.         PutObject(I, TStrings(Source).Objects[I]);
  4344.       end;
  4345.     finally
  4346.       EndUpdate;
  4347.     end;
  4348.     Exit;
  4349.   end;
  4350.   inherited Assign(Source);
  4351. end;
  4352.  
  4353. procedure TStringGridStrings.CalcXY(Index: Integer; var X, Y: Integer);
  4354. begin
  4355.   if FIndex = 0 then
  4356.   begin
  4357.     X := -1; Y := -1;
  4358.   end else if FIndex > 0 then
  4359.   begin
  4360.     X := Index;
  4361.     Y := FIndex - 1;
  4362.   end else
  4363.   begin
  4364.     X := -FIndex - 1;
  4365.     Y := Index;
  4366.   end;
  4367. end;
  4368.  
  4369. { Changes the meaning of Add to mean copy to the first empty string }
  4370. function TStringGridStrings.Add(const S: string): Integer;
  4371. var
  4372.   I: Integer;
  4373. begin
  4374.   for I := 0 to Count - 1 do
  4375.     if Strings[I] = '' then
  4376.     begin
  4377.       Strings[I] := S;
  4378.       Result := I;
  4379.       Exit;
  4380.     end;
  4381.   Result := -1;
  4382. end;
  4383.  
  4384. procedure TStringGridStrings.Clear;
  4385. var
  4386.   SSList: TStringSparseList;
  4387.   I: Integer;
  4388.  
  4389.   function BlankStr(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4390.   begin
  4391.     Objects[TheIndex] := nil;
  4392.     Strings[TheIndex] := '';
  4393.     Result := 0;
  4394.   end;
  4395.  
  4396. begin
  4397.   if FIndex > 0 then
  4398.   begin
  4399.     SSList := TStringSparseList(TSparseList(FGrid.FData)[FIndex - 1]);
  4400.     if SSList <> nil then SSList.List.ForAll(@BlankStr);
  4401.   end
  4402.   else if FIndex < 0 then
  4403.     for I := Count - 1 downto 0 do
  4404.     begin
  4405.       Objects[I] := nil;
  4406.       Strings[I] := '';
  4407.     end;
  4408. end;
  4409.  
  4410. procedure TStringGridStrings.Delete(Index: Integer);
  4411. begin
  4412.   InvalidOp(sInvalidStringGridOp);
  4413. end;
  4414.  
  4415. function TStringGridStrings.Get(Index: Integer): string;
  4416. var
  4417.   X, Y: Integer;
  4418. begin
  4419.   CalcXY(Index, X, Y);
  4420.   if X < 0 then Result := '' else Result := FGrid.Cells[X, Y];
  4421. end;
  4422.  
  4423. function TStringGridStrings.GetCount: Integer;
  4424. begin
  4425.   { Count of a row is the column count, and vice versa }
  4426.   if FIndex = 0 then Result := 0
  4427.   else if FIndex > 0 then Result := Integer(FGrid.ColCount)
  4428.   else Result := Integer(FGrid.RowCount);
  4429. end;
  4430.  
  4431. function TStringGridStrings.GetObject(Index: Integer): TObject;
  4432. var
  4433.   X, Y: Integer;
  4434. begin
  4435.   CalcXY(Index, X, Y);
  4436.   if X < 0 then Result := nil else Result := FGrid.Objects[X, Y];
  4437. end;
  4438.  
  4439. procedure TStringGridStrings.Insert(Index: Integer; const S: string);
  4440. begin
  4441.   InvalidOp(sInvalidStringGridOp);
  4442. end;
  4443.  
  4444. procedure TStringGridStrings.Put(Index: Integer; const S: string);
  4445. var
  4446.   X, Y: Integer;
  4447. begin
  4448.   CalcXY(Index, X, Y);
  4449.   FGrid.Cells[X, Y] := S;
  4450. end;
  4451.  
  4452. procedure TStringGridStrings.PutObject(Index: Integer; AObject: TObject);
  4453. var
  4454.   X, Y: Integer;
  4455. begin
  4456.   CalcXY(Index, X, Y);
  4457.   FGrid.Objects[X, Y] := AObject;
  4458. end;
  4459.  
  4460. procedure TStringGridStrings.SetUpdateState(Updating: Boolean);
  4461. begin
  4462.   FGrid.SetUpdateState(Updating);
  4463. end;
  4464.  
  4465. { TStringGrid }
  4466.  
  4467. constructor TStringGrid.Create(AOwner: TComponent);
  4468. begin
  4469.   inherited Create(AOwner);
  4470.   Initialize;
  4471. end;
  4472.  
  4473. destructor TStringGrid.Destroy;
  4474.   function FreeItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4475.   begin
  4476.     TObject(TheItem).Free;
  4477.     Result := 0;
  4478.   end;
  4479.  
  4480. begin
  4481.   if FRows <> nil then
  4482.   begin
  4483.     TSparseList(FRows).ForAll(@FreeItem);
  4484.     TSparseList(FRows).Free;
  4485.   end;
  4486.   if FCols <> nil then
  4487.   begin
  4488.     TSparseList(FCols).ForAll(@FreeItem);
  4489.     TSparseList(FCols).Free;
  4490.   end;
  4491.   if FData <> nil then
  4492.   begin
  4493.     TSparseList(FData).ForAll(@FreeItem);
  4494.     TSparseList(FData).Free;
  4495.   end;
  4496.   inherited Destroy;
  4497. end;
  4498.  
  4499. procedure TStringGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  4500.  
  4501.   function MoveColData(Index: Integer; ARow: TStringSparseList): Integer; far;
  4502.   begin
  4503.     ARow.Move(FromIndex, ToIndex);
  4504.     Result := 0;
  4505.   end;
  4506.  
  4507. begin
  4508.   TSparseList(FData).ForAll(@MoveColData);
  4509.   Invalidate;
  4510.   inherited ColumnMoved(FromIndex, ToIndex);
  4511. end;
  4512.  
  4513. procedure TStringGrid.RowMoved(FromIndex, ToIndex: Longint);
  4514. begin
  4515.   TSparseList(FData).Move(FromIndex, ToIndex);
  4516.   Invalidate;
  4517.   inherited RowMoved(FromIndex, ToIndex);
  4518. end;
  4519.  
  4520. function TStringGrid.GetEditText(ACol, ARow: Longint): string;
  4521. begin
  4522.   Result := Cells[ACol, ARow];
  4523.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  4524. end;
  4525.  
  4526. procedure TStringGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  4527. begin
  4528.   DisableEditUpdate;
  4529.   try
  4530.     if Value <> Cells[ACol, ARow] then Cells[ACol, ARow] := Value;
  4531.   finally
  4532.     EnableEditUpdate;
  4533.   end;
  4534.   inherited SetEditText(ACol, ARow, Value);
  4535. end;
  4536.  
  4537. procedure TStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  4538.   AState: TGridDrawState);
  4539.  
  4540.   procedure DrawCellText;
  4541.   var
  4542.     S: string;
  4543.   begin
  4544.     S := Cells[ACol, ARow];
  4545.     ExtTextOut(Canvas.Handle, ARect.Left + 2, ARect.Top + 2, ETO_CLIPPED or
  4546.       ETO_OPAQUE, @ARect, PChar(S), Length(S), nil);
  4547.   end;
  4548.  
  4549. begin
  4550.   if DefaultDrawing then DrawCellText;
  4551.   inherited DrawCell(ACol, ARow, ARect, AState);
  4552. end;
  4553.  
  4554. procedure TStringGrid.DisableEditUpdate;
  4555. begin
  4556.   Inc(FEditUpdate);
  4557. end;
  4558.  
  4559. procedure TStringGrid.EnableEditUpdate;
  4560. begin
  4561.   Dec(FEditUpdate);
  4562. end;
  4563.  
  4564. procedure TStringGrid.Initialize;
  4565. var
  4566.   quantum: TSPAQuantum;
  4567. begin
  4568.   if FCols = nil then
  4569.   begin
  4570.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  4571.     FCols := TSparseList.Create(quantum);
  4572.   end;
  4573.   if RowCount > 256 then quantum := SPALarge else quantum := SPASmall;
  4574.   if FRows = nil then FRows := TSparseList.Create(quantum);
  4575.   if FData = nil then FData := TSparseList.Create(quantum);
  4576. end;
  4577.  
  4578. procedure TStringGrid.SetUpdateState(Updating: Boolean);
  4579. begin
  4580.   FUpdating := Updating;
  4581.   if not Updating and FNeedsUpdating then
  4582.   begin
  4583.     InvalidateGrid;
  4584.     FNeedsUpdating := False;
  4585.   end;
  4586. end;
  4587.  
  4588. procedure TStringGrid.Update(ACol, ARow: Integer);
  4589. begin
  4590.   if not FUpdating then InvalidateCell(ACol, ARow)
  4591.   else FNeedsUpdating := True;
  4592.   if (ACol = Col) and (ARow = Row) and (FEditUpdate = 0) then InvalidateEditor;
  4593. end;
  4594.  
  4595. function  TStringGrid.EnsureColRow(Index: Integer; IsCol: Boolean):
  4596.   TStringGridStrings;
  4597. var
  4598.   RCIndex: Integer;
  4599.   PList: ^TSparseList;
  4600. begin
  4601.   if IsCol then PList := @FCols else PList := @FRows;
  4602.   Result := TStringGridStrings(PList^[Index]);
  4603.   if Result = nil then
  4604.   begin
  4605.     if IsCol then RCIndex := -Index - 1 else RCIndex := Index + 1;
  4606.     Result := TStringGridStrings.Create(Self, RCIndex);
  4607.     PList^[Index] := Result;
  4608.   end;
  4609. end;
  4610.  
  4611. function  TStringGrid.EnsureDataRow(ARow: Integer): Pointer;
  4612. var
  4613.   quantum: TSPAQuantum;
  4614. begin
  4615.   Result := TStringSparseList(TSparseList(FData)[ARow]);
  4616.   if Result = nil then
  4617.   begin
  4618.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  4619.     Result := TStringSparseList.Create(quantum);
  4620.     TSparseList(FData)[ARow] := Result;
  4621.   end;
  4622. end;
  4623.  
  4624. function TStringGrid.GetCells(ACol, ARow: Integer): string;
  4625. var
  4626.   ssl: TStringSparseList;
  4627. begin
  4628.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  4629.   if ssl = nil then Result := '' else Result := ssl[ACol];
  4630. end;
  4631.  
  4632. function TStringGrid.GetCols(Index: Integer): TStrings;
  4633. begin
  4634.   Result := EnsureColRow(Index, True);
  4635. end;
  4636.  
  4637. function TStringGrid.GetObjects(ACol, ARow: Integer): TObject;
  4638. var
  4639.   ssl: TStringSparseList;
  4640. begin
  4641.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  4642.   if ssl = nil then Result := nil else Result := ssl.Objects[ACol];
  4643. end;
  4644.  
  4645. function TStringGrid.GetRows(Index: Integer): TStrings;
  4646. begin
  4647.   Result := EnsureColRow(Index, False);
  4648. end;
  4649.  
  4650. procedure TStringGrid.SetCells(ACol, ARow: Integer; const Value: string);
  4651. begin
  4652.   TStringGridStrings(EnsureDataRow(ARow))[ACol] := Value;
  4653.   EnsureColRow(ACol, True);
  4654.   EnsureColRow(ARow, False);
  4655.   Update(ACol, ARow);
  4656. end;
  4657.  
  4658. procedure TStringGrid.SetCols(Index: Integer; Value: TStrings);
  4659. begin
  4660.   EnsureColRow(Index, True).Assign(Value);
  4661. end;
  4662.  
  4663. procedure TStringGrid.SetObjects(ACol, ARow: Integer; Value: TObject);
  4664. begin
  4665.   TStringGridStrings(EnsureDataRow(ARow)).Objects[ACol] := Value;
  4666.   EnsureColRow(ACol, True);
  4667.   EnsureColRow(ARow, False);
  4668.   Update(ACol, ARow);
  4669. end;
  4670.  
  4671. procedure TStringGrid.SetRows(Index: Integer; Value: TStrings);
  4672. begin
  4673.   EnsureColRow(Index, False).Assign(Value);
  4674. end;
  4675.  
  4676. end.
  4677.  
  4678.  
  4679.